我的搜索宏未返回搜索值

时间：2013-08-12 01:14:52

标签： excel vba excel-vba

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

谢谢

3 个答案:

答案 0 :(得分：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

答案 1 :(得分：0)

同意内森。

另外，请务必将Application.ScreenUpdating = False混合使用ActiveWorkbook，ActiveSheet，ActiveCell。

您的Find_String应该引用对象而不仅仅是activeworkbook的范围

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

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

如果您认为活动对象始终是您所追求的对象，则很难进行调试。

答案 2 :(得分：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
相关问题
最新问题