Excel宏查找文本，查找参考单元格，从参考单元格复制数据到固定位置

Posted 2023-04-19

【中文标题】Excel宏查找文本，查找参考单元格，从参考单元格复制数据到固定位置

【英文标题】：Excel macro to find text, find a reference cell, copy data in a fixed position from the reference cell

【发布时间】：2014-02-20 22:53:52

【问题描述】：

我希望我能理解这一点。

我正在尝试在 A 列中找到“Text1”，如果找到，请在“Text1”上方找到日期，最多显示 6 行并将“Text2”复制到那里并将其粘贴到另一个工作表中。然后我需要它从“Text1”的下一个实例再次执行所有操作。 “Text1”与日期的距离并不总是相同，“Text2”总是在日期上方 6 行并且是 City, State 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

【参考方案1】：

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

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

【讨论】：

这太棒了！！！它不仅工作得很好，这将帮助我理解一切是如何工作的，而且我可以让我做的其他一些事情更有效率。你摇滚！

@user3310806 就是这个想法 :) 如果有帮助，请标记为正确，不客气。

我不确定发生了什么，但效果很好。现在我得到一个运行时 1004：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. 上的应用程序定义或对象定义错误我以为我可能意外更改了一些东西，所以我添加了一个新模块并再次复制代码，我得到了同样的错误。我的工作簿是否已损坏？

@user3310806 不，您的工作簿可能没问题。您应该确保在同一个 Excel 实例中打开了两个工作簿。例如，如果您单击打开一个 excel 文件，然后打开另一个 excel 文件，它们将在同一个窗口和 excel 实例中打开。但是，如果您转到 excel 应用程序并再次启动它，则会打开第二个窗口和实例。代码居所假定两个工作簿都在同一个实例中打开。如果您可以同时查看两个工作簿，则它们位于不同的实例中。如果您仍然遇到问题，您可能需要创建一个新问题。