2

我已经编译了一个在 excel 文件中搜索值的代码，例如该值是“D0”。当我单独测试搜索代码时，它起作用了。但是，当我将搜索代码与循环文件的代码结合使用时，它不起作用。发现的问题是搜索没有返回值。我在代码中已经指出，该部分不起作用。所有，我想做的是将搜索代码与代码结合起来，该代码将获取写在 Excel 工作表列中的文件名，然后打开这些文件并执行搜索代码。

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 新手。因此，当我单独测试搜索代码时，无法弄清楚出了什么问题。是否与打开文件的激活有关？当我打开一个文件时，它没有被激活，因此搜索在包含宏而不是打开的文件的工作簿上运行，因此它无法返回搜索值？？？

谢谢

4

3 回答 3

0

同意内森。

此外，请始终避免Application.ScreenUpdating = False混合使用ActiveWorkbook, ActiveSheet, ActiveCell。

您的 Find_String 应该引用该对象，而不仅仅是活动工作簿的范围

Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value

Set oWSResult = Workbooks("book22.xlsx").Worksheets("Sheet2")
oWSResult.Range("B" & ...

如果您假定活动对象始终是您所追求的对象，则很难调试。

于 2013-08-12T02:29:09.320 回答
0

这是代码的改进版本。这应该运行得更快，并且 FindAll 函数更通用。

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
于 2013-08-12T03:43:01.213 回答
0

您的问题的一部分是变量的命名以及不断变化的工作簿和工作表上下文。在命名变量时要具体，这样你就知道它应该是什么，它会帮助你调试。

此外，您无需激活工作簿和工作表即可从范围和单元格中获取值。只需获得对工作表的引用，范围单元格就可以让您获得所需的内容。

看看这对你有用。

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
于 2013-08-12T02:05:31.530 回答