Excel宏查找文本，找到參考單元格，從參考單元中的固定位置複製數據

Question

我希望我可以使這有意義。

我試圖在列A中找到「Text1」，如果找到，找到「Text1」上面的日期，觸發6行並複製「Text2」並將其粘貼到另一個工作表中。然後我需要它再次從「Text1」的下一個實例中完成。 「文本1」與日期的距離並不總是相同的，「文本2」總是比日期高6行，並且是城市，州Zopcode。我真的只需要郵政編碼。

該文本來自每日文件，所以日期每天都在變化:)。我通常會找到一些代碼，並且能夠調整它們以適應我的工作，但我迄今爲止所嘗試的所有內容都無法正常工作。這在今天早些時候工作，但現在沒有通過（即我試過有無限循環結束所有的循環）不循環

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 

我得到運行時錯誤91：

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

Answer 1

我看到你仍在使用「激活」和「選擇」。當你剛剛起步時，這些都是常見的錯誤。正如我在my answer to another StackOverflow question中提到的那樣，您應該儘量避免這樣做。我繼續創建一個宏，我認爲它會完成你所要求的內容，並且包含了應該解釋每行代碼的註釋。這樣，您還可以查看代碼是如何工作的，以防您想要重新創建或修改它。讓我知道，如果它給你任何麻煩...

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