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

带循环的复杂Excel VBA宏

1 个答案: