Подсчитайте данные из разных рабочих книг и листов и вставьте их в одну рабочую книгу

Question

Я хочу посчитать, сколько раз буква «T» появляется в контрольном списке из различных рабочих книг (каждая состоит из примерно 11 листов), и вставить окончательные данные в одну рабочую книгу.

У меня есть этот код, ноя продолжаю получать

"код ошибки 9"

Я почти уверен, что определил правильную книгу. Есть ли другие способы достичь моих окончательных результатов? Заранее спасибо

Private Sub CommandButton3_Click()
Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim x As Integer

Dim wash_count As Integer


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents


For Each ws In wb.Sheets
    If ws.Name <> "Summary" Then

        For x = 5 To 74
            If ws.Cells(x, 2).Value = "Wash" And (ws.Cells(x, 4).Value = "T") Then
            wash_count = wash_count + 1

            End If

        Next x

    End If
Next ws

wb1 = Workbooks("Book3.xlsx")
wb1.Activate
wb.Sheets("Summary").Range("D6") = wash_count

'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

Я сделаю все возможное, чтобы помочь :) Я считаю, что основной причиной проблемы было то, что вы использовали 'wb1 = ...' вместо 'set wb1 = ..'. Я сделал несколько дополнительных правок и комментариев к коду, и он, кажется, работает хорошо для меня. Мне любопытно, решит ли это проблему и для вас.

Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim x As Integer

Dim wash_count As Integer


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

   With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
  DoEvents


    For Each ws In wb.Sheets
        If ws.Name <> "Summary" Then

            For x = 5 To 74
                If StrConv(ws.Cells(x, 2).Value, vbProperCase) = "Wash" And StrConv(ws.Cells(x, 4).Value, vbProperCase) = "T" Then 'added the StrConv to make sure you don't loose a case just because it was written in capital or lowercase letters
                wash_count = wash_count + 1

                End If

            Next x

        End If
    Next ws


    Set wb1 = Workbooks("Book3.xlsx") 'wb1 = Workbooks("Book3.xlsx")
        'changed your code 'wb1 = Workbooks("Book3")' to set 'wb1 =...' as workbook variables need to be assigned with 'set' command
        'you might want to add some handling of whether the workbook 'Book3' is already opened and if not then to open it

    'this seem strange to me, I thought you wanted to count the 'T's in all of the workbooks
    'in the folder and then paste the final number to one place
    'which I thought was going to be wb1 'Book3'
    'if that was the case then the line 'wb.Sheets("Summary").Range("D6") = wash_count' should be
    '-> 'wb1.Sheets("Summary").Range("D6") = wash_count'
        'also I'd move the whole line after the loop and paste only the final wash_count in the very end
    wb.Sheets("Summary").Range("D6") = wash_count

    'Save and Close Workbook
          wb.Close SaveChanges:=True

        'Ensure Workbook has closed before moving on to next line of code
          DoEvents

        'Get next file name
          myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True