vba - 带循环的复杂 Excel VBA 宏

Question

对于我提供的数据集，我需要一个相当复杂的 VBA 宏循环的帮助。数据集作为一长列存在数千个不同的条目。

我试过录制宏，但我不知道最好的方法。任何帮助将不胜感激。用最简单的术语来说，我需要找到一个术语(即“这是一个测试”)，将该单元格复制到新工作表中，向上移动 72 个单元格并将该单元格中的任何内容也复制到新工作表中。

VBA 宏循环的逻辑...

浏览所有工作表中的“这是一个测试”

将该单元格复制到新工作表中(例如 A1)

向上 72 个单元格

将该单元格复制到新工作表中(例如 B1)

它需要在所有打开的工作表中循环上述逻辑，将结果转储到新的工作表中。

再次感谢我收到的任何帮助。

Answer 1

这是一个开始。您的笔记表明单词在每张纸上只会出现一次，并且后面会有一个 72 行的单元格。我已经附上了检查这两个项目的注释，但只是粗略的。

Dim c As Range
Dim s As Worksheet
Dim sr As Worksheet ''For results
Dim r1 As Long ''Row counter
Dim i As Long ''Incidence counter
Dim firstAddress As Variant

''New worksheet for results
Set sr = ActiveWorkbook.Worksheets.Add
r1 = 1

''It might be better to use a named workbook
For Each s In ActiveWorkbook.Worksheets
    ''Don't check results sheet
    If s.Name <> sr.Name Then
    ''From: http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx
        With s.UsedRange
            Set c = .Find("THIS IS A TEST", LookIn:=xlValues, LookAt:=xlWhole)
            i = 0
            If Not c Is Nothing Then
                firstAddress = c.Address
                sr.Cells(r1, 1) = c.Value

                If c.Row - 72 > 0 Then
                    sr.Cells(r1, 2) = s.Cells(c.Row - 72, c.Column)
                Else
                    sr.Cells(r1, 2) = "Error"
                End If

                i = 1
                r1 = r1 + 1

                Do
                    i = i + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End If
    Debug.Print s.Name & " found: " & i
Next