如何根据遍历所有行的单元格内容插入行

Question

我正在尝试编写一个宏来整理和询问从某些分析仪器导出的原始数据。我希望它浏览所有行的一列（样本名称）并查找特定样本类型的指标，例如重复。找到这些指标我想插入一行，并在新插入的行中根据上面的两行做一些简单的计算。现在我会很高兴让行插入工作。

我可以让它找到关键字并插入 1 行，但它找到第一个并停止。我的数据中有多个这些关键字的实例，我想在每个实例下方插入一行

'original code - finds first keyword, inserts row and stops

Sub dup_finder()
    Dim colHeader As Range

    Set colHeader = Range("B1:B500")


Dim currCell As Range
Set currCell = Cells.Find("*_dup")

If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown


End Sub

'my attempt to include loop - inserts 500 rows below keyword! stops 
after first instance

Sub dup_finder()
Dim colHeader As Range
Dim row As Long
Dim currCell As Range

Set colHeader = Range("B1:B500")

Set currCell = Cells.Find("_dup")
        For row = 1 To 500
If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown

 Next row

End Sub

Answer 1

我建议始终使用工作簿和工作表完全限定您的范围。

您应该能够根据自己的需要进行调整。您只需输入要签入的范围和要检查的值。

它向后工作，向上通过范围，在找到的每个下方插入一行。

    Sub InsertRows()
        ''Declare your variables
        Dim RngToCheck As Range, ValToFind As String
        ''Set the range in which to look for your desired string.
        Set RngToCheck = ThisWorkbook.Sheets("Sheet1").Range("B1:B500")
        ''Set what string to look for.
        ValToFind = "_dup"

        ''Declare a variable to use as a counter
        Dim i As Long
        ''Count backwards through each of the rows in the range.
        ''(If you went forwards through the range, the rows you
        ''are inserting would become part of that range and push
        ''the bottom rows (which you intended to check) out of the range).
        For i = RngToCheck.Rows.Count To 1 Step -1
            ''Check if the last characters (the number of characters to
            ''check is defined by the length of the string we are looking
            ''for) of the current cell match the string we are looking for.
            If Right(RngToCheck(i).Value, Len(ValToFind)) = ValToFind Then
                ''Insert the row (we need to offset by 1 row
                ''because rows are inserted ABOVE, and we
                ''want it BELOW the current cell).
                RngToCheck(i).Offset(1, 0).EntireRow.Insert
                ''Now you can add your formulas to the new row...
                ''column A
                RngToCheck(i).Offset(1, -1).Formula = "=1+1"
                ''column B
                RngToCheck(i).Offset(1, 0).Formula = "=2+2"
                ''column C
                RngToCheck(i).Offset(1, 1).Formula = "=A" & RngToCheck(i).Offset(1, 1).Row & "+B" & RngToCheck(i).Offset(1, 1).Row
                ''column D
                RngToCheck(i).Offset(1, 2).Formula = "Hello"
                ''And so on...
            End If
        Next i
    End Sub

Answer 2

假设您确实想在 B 列中包含“_dup”的单元格的每个实例下插入一行，这应该可以工作。

您的代码的问题在于它没有循环，因此只找到了一个实例。

建议不要在插入行时指定固定范围，并且范围会扩大；但是，您可以这样做并将搜索方向设置为“上一个”。

Sub dup_finder()

Dim colHeader As Range, s As String

Set colHeader = Range("B1:B500") ' not actually used

Dim currCell As Range

'are we searching just B or the whole sheet?
Set currCell = Columns(2).Find(What:="_dup", Lookat:=xlPart, MatchCase:=False, SearchFormat:=False) 'change parameters to suit

If Not currCell Is Nothing Then
    s = currCell.Address             'store address of first found cell
    Do
        currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Set currCell = Columns(2).FindNext(currCell)  'find next case
    Loop Until currCell.Address = s  'keep looping until we are back to the original case
End If

End Sub