Question

我是VBA编程的新手，我需要一些帮助在Excel 2010中编写一个简单的宏。

问题在于：A列中大约有20个字符串文本（项目），它们一遍又一遍地重复，即工作表有5列和大约20000行（行数可以稍后扩展），以及这些项目每隔约20或21行重复A列。

现在，应该可以在宏的帮助下搜索A列中的每个项目（文本字符串），如果在单元格中找到该字符串，则将该单元格的整行剪切并粘贴到另一个工作表中。工作簿。这应该每20个项目完成。这意味着，最后，在使用宏之后，有20个新的工作表，包含所有相同的项目，工作表的名称也是该特定项目。

希望这很清楚，我正在寻找什么！我可以找到一些代码来搜索一个项目并将其复制/粘贴到一个新的工作表中，但我不能只为一个宏中的每20个项目执行此操作。如果有人可以提供帮助，我会很高兴的！提前谢谢！

Sub Search()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim i As Long
    Dim NewSh As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    MyArr = Array("PI18303")
    Set NewSh = Worksheets.Add
    NewSh.Name = "PI18303"

    With Sheets("Sheet1").Range("A1:Z100000")
        Rcount = 0
        For i = LBound(MyArr) To UBound(MyArr)
            Set Rng = .Find(What:=MyArr(i), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1
                    Rng.Copy NewSh.Range("A" & Rcount)
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next i
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


End Sub

Answer 1

我认为还有另一篇帖子可能会做你想要的; please check it out。但是，您不需要寻找标题，而是需要查找A列。

'change this: Set rLNColumn = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole)
'to this:
Set rLNColumn = Sheets("Sheet1").Range("A1:Z100000")

那应该让你亲近。

如何复制不同的文本字符串并粘贴到新的表格中？

1 个答案: