vba Excel宏查找文本，查找引用单元格，从引用单元格复制固定位置的数据

Excel macro to find text, find a reference cell, copy data in a fixed position from the reference cell

提问by cww

I hope I can make this make sense.

我希望我能让这有意义。

I am trying to find "Text1" in column A and if found, find the date above "Text1", offest up 6 rows and copy "Text2" there and paste it into another worksheet. Then I need it to do it all again from the next instance of "Text1". "Text1" not always the same distance from the date, "Text2" is always 6 rows above the date and is City, State Zopcode. I really only need the zipcode.

我试图在 A 列中找到“Text1”，如果找到，找到“Text1”上方的日期，排列 6 行并在那里复制“Text2”并将其粘贴到另一个工作表中。然后我需要它从“Text1”的下一个实例再次执行所有操作。“Text1”与日期的距离并不总是相同，“Text2”总是在日期上方 6 行并且是 City, State Zopcode。我真的只需要邮政编码。

The text is from a daily file so the date changes daily :). I usually find pieces of code and am able to tweak them to work for me, but everything I've tried so far hasn't worked. This worked earlier today, but doesn't now and doesn't loop through (all loops that I've tried have ended with infinite loops)

文本来自每日文件，因此日期每天都在变化:)。我通常会找到一些代码片段并且能够调整它们以适合我，但是到目前为止我尝试过的一切都没有奏效。这在今天早些时候有效，但现在没有，也没有循环（我尝试过的所有循环都以无限循环结束）

Sub GetZip()

Worksheets("Data_Test").Activate
Range("A1").Activate

' FInd first instance of Text1
Cells.Find(What:="Text1", After:=ActiveCell).Activate

' Find the date    
Cells.Find(What:="12-Feb-14", After:=ActiveCell, SearchDirection:=xlPrevious).Select
' copy and paste Text2
ActiveCell.Offset(-6, 0).Copy
Worksheets("Data2").Select
Range("A65000").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial (xlPasteAll)
Worksheets("Data_Test").Activate

'go back to Text1 that was found before
Cells.Find(What:="Housing Counseling Agencies", After:=ActiveCell).Activate
'find the next instance of Text1
Cells.Find(What:="Housing Counseling Agencies", After:=ActiveCell).Activate


End Sub

I get Run-time error 91 on:

我收到运行时错误 91：

Cells.Find(What:="12-Feb-14", After:=ActiveCell, SearchDirection:=xlPrevious).Activate

回答by Lopsided

I see that you are still over-using "Activate" and "Select". These are common mistakes when you are just starting out. As I mentioned in my answer to another StackOverflow question, you should try to avoid doing that. I went ahead and created a macro that I think will do what you've asked, and I included comments which should explain each line of code. This way, you can also see how the code works in case you want to recreate or modify it. Let me know if it gives you any trouble...

我看到您仍然过度使用“激活”和“选择”。这些都是刚开始时常见的错误。正如我在对另一个 StackOverflow 问题的回答中提到的，您应该尽量避免这样做。我继续创建了一个宏，我认为它可以满足您的要求，并且我包含了应该解释每一行代码的注释。这样，您还可以查看代码如何工作，以防您想重新创建或修改它。如果它给您带来任何麻烦，请告诉我...

Sub GetZip()

Dim Report As Worksheet, bReport As Workbook, Report2 As Worksheet 'Create your worksheet and workbook variables.
Dim i As Integer, k As Integer, j As Integer, m As Integer 'Create some variables for counting.
Dim iCount As Integer, c As Integer 'This variable will hold the index of the array of "Text1" instances.
Dim myDate As String, Text2 As String, Text1 As String, Data_Test As String, Data2 As String 'Create some string variables to hold your data.
Dim rText1() As Integer 'Create an array to store the row numbers we'll reference later.
Dim r As Range 'Create a range variable to hold the range we need.

'==============================================================================================================================
' Below are three variables: Text1, Data_Test, and Data2.
' These represent variables in your specific scenario that I did not know what to put. Change them accordingly.
'==============================================================================================================================
'Enter your "Text1" value below (e.g., "Housing Counseling Agencies")
Text1 = "Text1" 'Assign the text we want to search for to our Text1 variable.

'Enter the names of your two worksheets below
Data_Test = "Data_Test" 'Assign the name of our "Data_Test" worksheet.
Data2 = "Data2" 'Assign the name of our "Data2" worksheet.


'==============================================================================================================================
' This assigns our worksheet and workbook variables.
'==============================================================================================================================
On Error GoTo wksheetError 'Set an error-catcher in case the worksheets aren't found.
Set bReport = Excel.ActiveWorkbook 'Set your current workbook to our workbook variable.
Set Report = bReport.Worksheets(Data_Test) 'Set the Data_Test worksheet to our first worksheet variable.
Set Report2 = bReport.Worksheets(Data2) 'Set the Data2 worksheet to our second worksheet variable.
On Error GoTo 0 'Reset the error-catcher to default.



'==============================================================================================================================
' This gets an array of row numbers for our text.
'==============================================================================================================================
iCount = Application.WorksheetFunction.CountIf(Report.Columns("A"), Text1) 'Get the total number of instances of our text.
If iCount = 0 Then GoTo noText1 'If no instances were found.
ReDim rText1(1 To iCount) 'Redefine the boundaries of the array.

i = 1 'Assign a temp variable for this next snippet.
For c = 1 To iCount 'Loop through the items in the array.
    Set r = Report.Range("A" & i & ":A" & Report.UsedRange.Rows.Count + 1) 'Get the range starting with the row after the last instance of Text1.
    rText1(c) = r.Find(Text1).Row 'Find the specified text you want to search for and store its row number in our array.
    i = rText1(c) + 1 'Re-assign the temp variable to equal the row after the last instance of Text1.
Next c 'Go to the next array item.


'==============================================================================================================================
' This loops through the array and finds the date and Text2 values, then places them in your new sheet.
'==============================================================================================================================
For c = 1 To iCount 'Loop through the array.
    k = rText1(c) 'Assign the current array-item's row to k.
    For i = k To 1 Step -1 'Loop upward through each row, checking if the value is a date.
        If IsDate(Report.Cells(i, 1).Value) Then 'If the value is a date, then...
            myDate = Report.Cells(i, 1).Value 'Assign the value to our myDate variable.
            j = i 'Set the j variable equal to the current row (we want to use it later).
            Exit For 'Leave the loop since we've found our date value. **Note: jumps to the line after "Next i".
        End If
    Next i 'Go to the next row value.


    Text2 = Report.Cells(j - 6, 1).Value 'Subtract the date row by six, and store the "Text2"/[city, state, zip] value in our Text2 variable.
    m = Report2.Cells(Report2.UsedRange.Rows.Count + 1, 1).End(xlUp).Row + 1 'Get the row after the last cell in column "A" that contains a value.
    Report2.Cells(m, 1).Value = Text2 'Paste the value of the city,state,zip into the first available cell in column "A"

Next c 'Go to the next array-item.





Exit Sub
wksheetError:
    MsgBox ("The worksheet was not found.")
    Exit Sub

noText1:
    MsgBox ("""" & Text1 & """ was not found in the worksheet.") 'Display an error message. **NOTE: Double-quotations acts as a single quotation in strings.
    Exit Sub

End Sub