VBA搜索列中的字符串并将行复制到新工作表

这里的VBA不是很好。找到并编辑了一些我相信可以帮助我的代码。 我需要这段代码来搜索两列（L和M）中以_LC _LR等结尾的任何字符串。。。示例：xxxxxxxx信用证。 如果单元格以数组中的任何内容结尾，则需要将该行复制到新的工作表中。以下是我所拥有的：

 Option Explicit

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String
Dim maxKeywords As Integer


maxKeywords = 6
ReDim keywords(1 To maxKeywords)

maxKeywords(1) = "_LC"
maxKeywords(2) = "_LR"
maxKeywords(3) = "_LF"
maxKeywords(4) = "_W"
maxKeywords(5) = "_R"
maxKeywords(6) = "_RW"

lngLstRow = ActiveSheet.UsedRange.Rows.Count

For Each rngCell In Range("L2:L, M2:M" & lngLstRow)
    For i = 1 To maxKeywords
            If keywords(i) = rngCell.Value Then
                rngCell.EntireRow.Copy
                    Sheets("sheet1").Select
                        Range("L65536, M65536").End(xlUp).Offset(1, 0).Select
                        Selection.PasteSpecial xlPasteValues
                    Sheets("Results").Select

            End If
        Next i
Next

End Sub

---

好的，我认为问题在于变量声明。在我继续之前，我将回应@gradehBacon的评论，即如果您不能阅读本文并理解发生了什么，您可能需要在运行之前花一些时间学习VBA

这应该行的，阿福。您没有指定哪个工作表包含哪些信息，因此可能需要对其进行调整。请尝试以下方法，并让我知道哪些方法有效/无效：

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String, maxKeywords() As String
Dim totalKeywords As Integer, i&
Dim ws As Worksheet, resultsWS As Worksheet

Set ws = Sheets("Sheet1")
Set resultsWS = Sheets("Results")

totalKeywords = 6
ReDim keywords(1 To totalKeywords)
ReDim maxKeywords(1 To totalKeywords)

maxKeywords(1) = "_LC"
maxKeywords(2) = "_LR"
maxKeywords(3) = "_LF"
maxKeywords(4) = "_W"
maxKeywords(5) = "_R"
maxKeywords(6) = "_RW"

 lngLstRow = ws.UsedRange.Rows.Count  'Assuming "Sheet1" is what you want to get the last range of.

Dim k&                       ' create a Long to use as Column numbers for the loop
For k = 12 To 13             ' 12 is column L, 13 is M
    With ws                  'I'm assuming your Ranges are on the "Sheet1" worksheet
        For Each rngCell In .Range(.Cells(1, k), .Cells(lngLstRow, k))
            For i = LBound(maxKeywords) To UBound(maxKeywords)
                If maxKeywords(i) = Right(rngCell.Value, 3) or maxKeywords(i) = Right(rngCell.Value, 2) Then
                    ' rngCell.EntireRow.Copy
                    ' ws.Range("L65536, M65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    resultsWS.Cells(65536, k).End(xlUp).Offset(1, 0).EntireRow.Value = rngCell.EntireRow.Value
                End If
            Next i
        Next rngCell
    End With
Next k
End Sub

---

这可能就是您正在寻找的：

==================================================

Option Explicit

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String
Dim maxKeywords, i, j, k As Integer


maxKeywords = 6
ReDim keywords(1 To maxKeywords)

keywords(1) = "_LC"
keywords(2) = "_LR"
keywords(3) = "_LF"
keywords(4) = "_W"
keywords(5) = "_R"
keywords(6) = "_RW"

lngLstRow = ActiveSheet.UsedRange.Rows.Count

For j = 1 To lngLstRow
  For i = 1 To maxKeywords
    If keywords(i) = Right(Sheets("Results").Range("L" & j).Value,     Len(keywords(i))) Or _
      keywords(i) = Right(Sheets("Results").Range("M" & j).Value, Len(keywords(i))) Then
        k = k + 1
          Rows(j & ":" & j).Copy
            Sheets("sheet1").Select
              Range("A" & k).Select
                ActiveSheet.Paste
    End If
  Next i
Next j

End Sub

---

“这就是我所拥有的”-它有什么作用？你测试过了吗？它有什么作用吗？此代码的效果与您的预期有何不同？有错误吗？您认为代码的哪一部分导致了这些差异？最重要的是，你能读懂代码吗？因为如果不是这样，你就不应该把你在网上找到的代码粘贴在一起。要背上@Grade'Eh'Bacon（没有可怕的双关语：P），这是行不通的：

Range（“L2:L，M2:M”和lngLstRow）

。我会退后一步，通读一遍，你应该能够看到如何从那里开始。谢谢你的回复。我很抱歉没有提供更多的信息。我一直收到这个错误编译错误：预期的数组。它突出显示了数组的第一个声明：maxKeywords（1），所以它不做任何事情。我也不确定范围。我认为我没有正确地编辑它。我参考了一些文章，想试试看。我知道它有一个If语句、一个数组和一个循环LOL。只是想加快我的工作速度。任何帮助都会很好。哦，哇。看看它，你混合了各种类型。是否将maxKeywords设置为整数，然后尝试将其重新分配到数组？那是行不通的。你只需要看一看，想一想，然后重新定义类型。例如，您可以将maxKeywords设置为整数，但几步后将其用作数组。感谢Bruce的帮助。代码运行时没有任何错误，但它没有做任何事情。“结果”表无人填写。布鲁斯，是的，范围在“表1”中。我创建了第二张标签为“结果”的表格。布鲁斯，是的，范围在“表格1”中。我创建了第二张标签为“结果”的表格。我在A-M列中有数据，L&M也有类似的字符串，xxxxxx\u LW。有些字符串没有_LW，那些我想留下的字符串。正如我之前所说，“结果”表没有人填写。我在这个工作簿和一个模块中运行了代码。再次感谢你的帮助。如果我们能让这个工作，我会很高兴地通过贝宝给你一些现金。我不能再花一个星期在excel中筛选行了。布鲁斯，你就是那个人！它正在做我需要它做的事情。不过还是有一个小问题。它没有选择像_W和_R这样的单数关键词。有没有简单的解决方法？我怎样才能得到你的贝宝？哇，布鲁斯，非常感谢你。它工作得非常完美，它让我的工作失去了最糟糕的一面！你是一个伟大的人，我很高兴你喜欢它！如果你改变了对PayPal的想法，就说吧！把它看作是一种善意的回报。你好，蓝，我也试过你的代码。它跑了，但什么也没做。