复制整个行如果单元格包含

Question

我试图自动化插入行并复制如果单元格中有“（4 SHEETS）”单元格A例如。我不知道如何开始这个。

如果aCell包含“（x SHEETS）”，则在aCell下插入x行。复制一个Cell。将变量粘贴到x行中。 Next

最终我想“（x SHEETS）”也被重命名。因此， “（4张）” 将变成4行与 “（4张）” 被修改为 “（第1页）”， “（第2页）” 等

感谢您的帮助

Answer 1

假设aCell位置在A1（单元地址[1,1]）中，然后获取aCell值，从aCell值中提取数字，然后根据aCell值创建行数。

Sub Main() 

    Dim aCell As String 
    Dim ws As Worksheet 
    Dim i As Long 
    Dim noOfSheet As String 

    Set ws = ThisWorkbook.Sheets("Sheet1") 
    aCell = ws.Cells(1, 1).Value 

    'Extract the no. of sheets from the cell 
    For i = 1 To Len(aCell) 
     If Mid(aCell, i, 1) >= "0" And Mid(aCell, i, 1) <= "9" Then 
      noOfSheet = noOfSheet + Mid(aCell, i, 1) 
     End If 
    Next 

    'Insert no. of row based on the no. of sheets 
    If CInt(noOfSheet) > 0 Then 
     For i = 1 To CInt(noOfSheet) 
      ws.Cells(1, 1).Offset(1, 0).EntireRow.Insert 
      ws.Cells(1, 1).Offset(1, 0).Value = "(SHEET " & CInt(noOfSheet) + 1 - i & ")" 
     Next i 
    End If 

End Sub