Excel-makro zum suchen von text, finden Sie eine Referenz der Zelle, kopieren von Daten in eine Feste position von der Referenz-Zelle

Sehe ich, dass Sie noch mehr-mit "Activate" und "Select". Dies sind die häufigsten Fehler, wenn Sie gerade erst anfangen. Wie ich bereits in meine Antwort zu einem anderen StackOverflow-Frage, sollten Sie versuchen zu vermeiden, das zu tun. Ich ging voran und ein makro erstellt, das denke ich wird tun, was Sie gefragt haben, und ich enthalten Kommentare, die erklären sollen, jede Zeile code. Auf diese Weise können Sie auch sehen, wie der code funktioniert, falls Sie möchten, neu zu erstellen oder zu modifizieren. Lassen Sie mich wissen, wenn es Ihnen keine Mühe...

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