2

たとえば、値が「D0」であると言うExcelファイルの値を検索するコードをコンパイルしました。検索コードを個別にテストしたところ、機能しました。しかし、検索コードをファイルをループするコードと組み合わせると、機能しません。見つかった問題は、検索で値が返されないことです。コードで指摘したのは、動作していない部分です。私がやろうとしているのは、検索コードと、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

問題の一部は、変数の命名と、ワークブックとワークシートのコンテキストの変更です。変数の名前付けを具体的にして、それが何であるべきかを理解し、デバッグに役立つようにします。

また、範囲とセルから値を取得するためにワークブックとワークシートをアクティブにする必要はありません。シート、範囲セルへの参照を取得するだけで、必要なものを取得できます。

これがあなたのためにトリックを行うのを見てください。

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 に答える
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 に答える