search单元格的string然后运行macros如果string被发现
现在我的macros运行，但没有得到所有的数字。 如果它在＃2上运行一次，则下一个＃2被跳过。 我怎样才能防止这一点。 我想要所有的＃被处理。
例：
你好（2张）
好（3张）
BYE（2张）
应该：
你好（2张）
你好（2张）
好（3张）
好（3张）
好（3张）
BYE（2张）
BYE（2张）
这是我迄今为止。
旧
Sub ExpandRows() Application.ScreenUpdating = False Dim ws As Worksheet Dim aCell As Range Dim i As Integer Set ws = ThisWorkbook.Sheets("Drawing Index") With ws For i = 2 To 99 Set aCell = .Columns(1).find(What:="(" & i & " SHEETS)", LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then aCell.EntireRow.Copy aCell.Resize(i - 1).EntireRow.Insert End If Application.StatusBar = "Duplicating rows containing (" & i & " SHEETS)..." Next i End With Application.CutCopyMode = False Application.ScreenUpdating = True Application.StatusBar = False End Sub 我被告知可能因为insert新行而跳过其他的匹配。 我怎样才能解决这个问题？ 有没有另一种方法。
EDIT_7.25.17
我试图让这个代码运行，如果一个单元格包含文本“片”。 我试了一堆东西，我卡住了。
Sub ExpandRows_if() Application.ScreenUpdating = False Dim ws As Worksheet, l As Long, n As Long, s As Long, tmp As String, rng As range, SearchChar As String Dim LastRow As Long, aCell As range LastRow = range("A" & Rows.Count).End(xlUp).Row Set rng = range("A3:A" & LastRow) Set ws = ThisWorkbook.Sheets("Drawing Index") SearchChar = "SHEETS" With ws For Each aCell In rng.Cells '(x) 'If aCell.FormulaR1C1 = "=Countifs(rng.value,""*SHEETS)*""),1,0)" > 0 Then '(x)_This works as a formula on the sheet If InStr(1, aCell, SearchChar, vbTextCompare) > 0 Then '(x)_Other option i am trying For l = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1 s = InStr(1, .Cells(l, "A").Value2, "(") If CBool(s) Then n = val(Mid(.Cells(l, "A").Value2, s + 1)) If n > 0 Then .Cells(l + 1, "A").Resize(n-1).EntireRow.Insert .Cells(1, "A").Resize(n + 1, 1).EntireRow.FillDown Application.StatusBar = "Duplicating rows containing (" & n & " SHEETS)" End If End If Next l Else '(x) MsgBox "Damn! Still not working", vbOKOnly, "F*@&" '(x) Exit Sub '(x) End If '(x) Next '(x) End With Application.ScreenUpdating = True Application.StatusBar = vbNullString End Sub
'(x)表示为了使IF语句正常工作而添加的新行。 没有这些代码的作品，但重复所有行。 那么它应该重复，但.FillDown似乎并没有工作。 ATM正在插入正确数量的行。
谢谢
迭代rng单元格的麻烦是，当你插入新的行时， rng会展开，这会弄乱你的序列。 我们不应该迭代受迭代语句影响的集合。
一个更原始的方法，使用指针variables和条件循环，可以让你重新控制你在工作表中的位置。
由于我注意到你的样本范围是从“A3”单元格开始的，我宁愿明确地定义一个起始行（在variablesFirstRow ，所以你可以参数化你的语句，或者至less编辑一个整洁，自我解释的点深入到你的代码的更深入的部分。
至于整洁，我也改变了Dim语句的风格，以获得更好的可读性。
所以，这应该做到这一点（它在我的testing工作）：
Sub ExpandRows_if() Dim ws As Worksheet Dim n As Long Dim s As Long Dim e As Long Dim l As Long Dim nl As Long Dim tmp As String Dim SearchChar As String Dim FirstRow As Long Dim LastRow As Long Dim aCell As Range Application.ScreenUpdating = False FirstRow = 1 LastRow = Range("A" & Rows.Count).End(xlUp).Row Set ws = ThisWorkbook.Sheets("Drawing Index") SearchChar = "SHEETS" With ws l = FirstRow Do Set aCell = .Cells(l, 1) If InStr(1, aCell, SearchChar, vbTextCompare) > 0 And _ InStr(1, aCell, "(", vbTextCompare) > 0 Then s = InStr(1, aCell, "(", vbTextCompare) e = InStr(s, aCell, " ", vbTextCompare) n = Mid(aCell.Value, s + 1, e - s - 1) If n > 1 Then Application.StatusBar = "Duplicating rows containing (" & n & " SHEETS)" For nl = 1 To n - 1 aCell.Offset(nl, 0).EntireRow.Insert aCell.Offset(nl, 0).Value = aCell.Value LastRow = LastRow + 1 ' Since a row was inserted, last and l = l + 1 ' current line pointers must increase by 1 Next End If End If l = l + 1 ' step to new line Loop While l <= LastRow End With Application.ScreenUpdating = True Application.StatusBar = vbNullString End Sub