在第一个出现的部分字符串上方插入具有特定值的行

时间:2019-05-13 10:54:18

标签: excel vba

我在一个工作簿中有多个工作表,并且对于该工作簿中的某些工作表,列A包含数据并在列A中找到部分字符串(例如"BAG"),并在第一次出现此值的上方插入一行"BAGBEE"

此外,我们可以将其应用于在A列中找到多个部分字符串吗(例如,如果找到"BAG",则上面插入的行应该是"BAGBEE",如果找到了"CAT",则上面的行插入的行应为"CATLINE"

任何帮助实现这一目标的人都很感激。

这将在底部插入行,但是我正在寻找一些在第一次出现部分字符串的顶部插入行的代码。

Sub try()
    Dim c As Range
    Dim lRow As Long
    lRow = 1
    Dim lRowLast As Long
    Dim bFound As Boolean
    With ActiveWorkbook.Worksheets("Requires Client Review")
    lRowLast = .Cells(.Rows.Count, 1).End(xlUp).Row
     Do
     Set c = .Range("A" & lRow)
     If c.Value Like "*BAG*" Then
     bFound = True
     ElseIf bFound Then
      bFound = False
     If c.Value <> "BAGBEE" Then
      c.EntireRow.Insert
     lRowLast = lRowLast + 1
     c.Offset(-1, 0).Value = "BAGBEE"
      c.Offset(-1, 0).Font.Color = RGB(0, 0, 0)
     End If
    End If
    lRow = lRow + 1
   Loop While lRow <= lRowLast + 1
   End With
  End Sub

1 个答案:

答案 0 :(得分:0)

在此处尝试此代码。我习惯于使用Cells作为参考。 我已经对其进行了测试,并且可以按预期工作。

已编辑以添加工作表循环。

Private Sub Try_it()
Dim LongRow     As Long
Dim Lastrow     As Long
Dim ArryText    As Variant
Dim WSheet      As Worksheet

For Each WSheet In Worksheets
    WSheet.Select
    Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For LongRow = Lastrow To 2 Step -1
        For Each ArryText In Array("*BAG*", "*CAT*") ' you can add your search word here
            If Cells(LongRow, 1) Like ArryText And Cells(LongRow - 1, 1) Like ArryText Then
                'do something
            ElseIf Cells(LongRow, 1) Like ArryText Then
                Select Case ArryText
                    Case "*BAG*" ' for each matched case you can assign it to whatever name you want
                        Rows(LongRow).Insert
                        Cells(LongRow, 1).Value = "BAGBEE"  'BAGBEE
                        Cells(LongRow, 1).Interior.ColorIndex = 6
                    Case "*CAT*" ' for each matched case you can assign it to whatever name you want
                        Rows(LongRow).Insert
                        Cells(LongRow, 1).Value = "CATLINE" 'CATLINE
                        Cells(LongRow, 1).Interior.ColorIndex = 6
                End Select
            End If
        Next
    Next
Next
End Sub