我的searchmacros没有返回search值
我已经编译了一个代码，在excel文件中search一个值，比如说这个值是'D0'。 当我单独testingsearch代码时，它工作。 但是，当我结合我的search代码与循环通过文件的代码不起作用。 发现的问题是，search不返回值。我已经在代码中指出，部分是不工作的。 所有，我试图做的是结合一个search代码与代码，将选取在Excel表中写入的文件名，然后打开这些文件并执行search代码。
Sub MyMacro() Dim MyCell, Rng As Range Dim Fname As String Dim FirstAddress As String Set Rng = Sheets("Sheet1").Range("A1:A6") 'sets the range to Read from For Each MyCell In Rng 'checks each cell in range If MyCell <> "" Then 'Picks up the file name present in the cell MyCell.Activate 'Activates the cell Fname = ActiveCell.Value 'Assigns the value of the cell to fname Application.ScreenUpdating = False Set wb = Workbooks.Open("C:\Users\" & Fname, True, True) 'opens the file wb.Worksheets("Sheet1").Activate 'activates the opened workbook Call Find_String 'calls the search code wb.Close SaveChanges:=False End If Next End Sub Sub Find_String() Dim FirstAddress As String Dim MySearch As Variant Dim Rng As Range Dim I As Long Dim strMyValu Dim Axis Dim wb As Workbook MySearch = Array("D0") 'value that needs to be searched Set wb = ActiveWorkbook 'trying to bring the opened workbook as active sheet With Sheets("Sheet1").Range("B1:H100") For I = LBound(MySearch) To UBound(MySearch) Set Rng = .Find(What:=MySearch(I), _After:=.Cells(.Cells.Count), _LookIn:=xlFormulas, _ LookAt:=xlWhole, _SearchOrder:=xlByRows, _SearchDirection:=xlNext, _MatchCase:=False) If Not Rng Is Nothing Then 'this is the part not working 'It should return the search value instead it returns nothing 'so as the value returned by the code is nothing and hence the code goes to endif FirstAddress = Rng.Address Do Sheets("Sheet1").Select 'Selecting sheet1 on opened file Rng.Activate strMyValue = ActiveCell.Offset(0, 6).Value 'Copying the offset value of the located cell Axis = ActiveCell.Offset(0, 3).Value Workbooks("book22.xlsx").Worksheets("Sheet2").Activate 'Activating the workbook where i want to paste the result Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = strMyValue Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Axis wb.Activate 'Activating the opened file again for loop to search for more values Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With End Sub 请帮助。 我感到震惊。 我是VBA新手。 所以，无法找出什么地方出了问题，因为当我testingsearch代码单独的工作。 这与打开文件的激活有关吗？ 当我打开一个文件，它不会被激活，因此search运行在包含macros，而不是打开的文件，所以它无法返回search值的工作簿？
谢谢
你的问题的一部分是variables的命名和变化的工作簿和工作表上下文。 具体在variables的命名，以便你知道它应该是什么，它会帮助你debugging。
此外，您不需要激活工作簿和工作表以获取范围和单元格中的值。 只是得到一个参考表，范围单元格将允许你得到你所需要的。
看到它，这是你的伎俩。
Option Explicit Sub MyMacro() Dim MyCell, Rng As Range Dim Fname As String Dim FirstAddress As String Dim searchSheet As Worksheet Dim copyToSheet As Worksheet Dim copyToWorkbook As Workbook Dim searchWorkbook As Workbook Set copyToWorkbook = Workbooks.Open("C:\Temp\workbook22.xlsx") Set copyToSheet = copyToWorkbook.Worksheets("Sheet2") Set Rng = Sheets("Sheet1").Range("A1:A6") 'sets the range to Read from For Each MyCell In Rng 'checks each cell in range If MyCell <> "" Then 'Picks up the file name present in the cell Fname = MyCell.Value 'Assigns the value of the cell to fname Set searchWorkbook = Workbooks.Open("C:\Temp\" & Fname, True, True) Set searchSheet = searchWorkbook.Worksheets("Sheet1") 'get a reference to the sheet to be searched Find_String searchSheet, copyToSheet 'calls the search code with the referenece sheet searchWorkbook.Close SaveChanges:=False End If Next copyToWorkbook.Close True End Sub Sub Find_String(searchSheet As Worksheet, copyToSheet As Worksheet) Dim FirstAddress As String Dim MySearch As Variant Dim Rng As Range Dim I As Long Dim strMyValue As String Dim Axis Dim foundCell As Range MySearch = Array("D0") 'value that needs to be searched With searchSheet.Range("B1:H100") For I = LBound(MySearch) To UBound(MySearch) Set Rng = .Find(What:=MySearch(I), After:=.Cells(.Cells.Count), LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not Rng Is Nothing Then 'this is the part not working 'It should return the search value instead it returns nothing 'so as the value returned by the code is nothing and hence the code goes to endif FirstAddress = Rng.Address Do strMyValue = Rng.Offset(0, 6).Value 'Copying the offset value of the located cell Axis = Rng.Offset(0, 3).Value copyToSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = strMyValue copyToSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Axis Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With End Sub
同意Nathan。
此外，总是应避免与ActiveWorkbook ， ActiveSheet ， ActiveCell混合Application.ScreenUpdating = False 。
你的Find_String应该引用对象，而不仅仅是活动工作簿的范围
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value
Set oWSResult = Workbooks("book22.xlsx").Worksheets("Sheet2") oWSResult.Range("B" & ...
如果您认为活动对象始终是您之后的对象，则很难进行debugging。
这是一个修改后的代码版本。 这应该运行得更快，FindAllfunction有点多才多艺。
Sub MyMacro() Dim wbDest As Workbook Dim wsDest As Worksheet Dim wsFileNames As Worksheet Dim DataBookCell As Range Dim rngCopy As Range Dim CopyCell As Range Dim arrData(1 To 65000, 1 To 2) As Variant Dim MySearch As Variant Dim varFind As Variant Dim BookIndex As Long Dim DataIndex As Long Set wbDest = ActiveWorkbook Set wsFileNames = wbDest.Sheets("Sheet1") Set wsDest = wbDest.Sheets("Sheet2") MySearch = Array("D0") For Each DataBookCell In wsFileNames.Range("A1", wsFileNames.Cells(Rows.Count, "A").End(xlUp)).Cells If Len(Dir("C:\Users\" & DataBookCell.Text)) > 0 And Len(DataBookCell.Text) > 0 Then With Workbooks.Open("C:\Users\" & DataBookCell.Text) For Each varFind In MySearch Set rngCopy = FindAll(varFind, .Sheets(1).Range("B1:H100")) If Not rngCopy Is Nothing Then For Each CopyCell In rngCopy.Cells DataIndex = DataIndex + 1 arrData(DataIndex, 1) = CopyCell.Offset(, 3).Value arrData(DataIndex, 2) = CopyCell.Offset(, 6).Value Next CopyCell End If Next varFind .Close False End With End If Next DataBookCell If DataIndex > 0 Then wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(DataIndex, UBound(arrData, 2)).Value = arrData Set wbDest = Nothing Set wsFileNames = Nothing Set wsDest = Nothing Set DataBookCell = Nothing Set rngCopy = Nothing Set CopyCell = Nothing Erase arrData If IsArray(MySearch) Then Erase MySearch End Sub Public Function FindAll(ByVal varFind As Variant, ByVal rngSearch As Range, _ Optional ByVal LookIn As XlFindLookIn = xlValues, _ Optional ByVal LookAt As XlLookAt = xlWhole, _ Optional ByVal MatchCase As Boolean = False) As Range Dim rngAll As Range Dim rngFound As Range Dim strFirst As String Set rngFound = rngSearch.Find(varFind, rngSearch.Cells(rngSearch.Cells.Count), LookIn, LookAt, MatchCase:=MatchCase) If Not rngFound Is Nothing Then strFirst = rngFound.Address Set rngAll = rngFound Do Set rngAll = Union(rngAll, rngFound) Set rngFound = rngSearch.Find(varFind, rngFound, LookIn, LookAt, MatchCase:=MatchCase) Loop While rngFound.Address <> strFirst Set FindAll = rngAll Else Set FindAll = Nothing End If Set rngAll = Nothing Set rngFound = Nothing End Function