带循环的复杂 Excel VBA 宏答案

【问题标题】：Complicated Excel VBA Macro with Loop带循环的复杂 Excel VBA 宏
【发布时间】：2010-09-02 05:20:10
【问题描述】：

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

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

VBA 宏循环的逻辑...

浏览所有工作表中的“这是一个测试”字样
将该单元格复制到新工作表中（例如 A1）
向上移动 72 个单元
将该单元格复制到新工作表中（例如 B1）

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

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

【问题讨论】：

标签： vba excel spreadsheet

【解决方案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

【讨论】：