Question

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'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

   'Here I want my code
   Sub Licenses()
Dim transientLicense As Integer
    Dim steadyLicense As Integer
    Dim staticLicense As Integer
    Dim arr1 As Variant, arr2 As Variant, elem As Variant

    arr1 = Array("radial vibration", "acceleration", "acceleration2", "velocity", "velocity2") '<--| set your first values list
    arr2 = Array("axial vibration", "temperature", "pressure") '<--| set your 2nd values list
    With Worksheets("Rack Properties") '<-| reference your relevant worksheet
        With .Range("D1", Cells(Rows.Count, "AH").End(xlUp)) '<--| reference its columns D to AH range from row 1 down to column AH last not empty row
            For Each elem In arr1 '<--| loop through 1st array list
                transientLicense = transientLicense + WorksheetFunction.CountIfs(.Columns(1), "active", .Columns(20), "yes", .Columns(31), elem) '<-- update 'transientLicense' for every record matching: "active" in referenced range column 1(i.e. "D"), "yes" in referenced range column 20 (i.e. "W") and current list element in referenced range column 31 (i.e. "AH")
                steadyLicense = steadyLicense + WorksheetFunction.CountIfs(.Columns(1), "active", .Columns(20), "no", .Columns(31), elem) '<-- update 'steadyLicense' for every record matching: "active" in referenced range column 1(i.e. "D"), "no" in referenced range column 20 (i.e. "W") and current list element in referenced range column 31 (i.e. "AH")
            Next elem
            For Each elem In arr2 '<--| loop through 2nd array list
                staticLicense = staticLicense + WorksheetFunction.CountIfs(.Columns(1), "active", .Columns(31), elem) '<-- update 'staticLicense' for every record matching: "active" in referenced range column 1(i.e. "D") and current list element in referenced range column 31 (i.e. "AH")
            Next elem
        End With
    End With

 With Worksheets.Add
        .Name = "Results"
        .Columns("B:D").ColumnWidth = 20
        .Range("B2:D2").Value = Array("Transient Licenses", "Steady Licenses", "Static Licenses")
        .Range("B3:D3").Value = Array(transientLicense, steadyLicense, staticLicense)
    End With
End Sub



    '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

我想打开给定文件夹中的所有Excel工作表，并计算每个工作表中的许可证总数，并在另一个工作簿中显示输出。我刚刚开始学习VBA，我无法在宏中使用它。真的很感激一点帮助。非常感谢你提前:)）

Answer 1

你需要将你的例程分开，然后从另一个中调用一个。

Sub Test()
  Dim counter As Long
  For counter = 1 to 5
    DoSomething
  Next counter
End Sub

Sub DoSomething()
  Beep
End Sub

Answer 2

你只是这样做。

Sub RunSub1

'...code
'...code
'...code

Call SubRun2
End Sub

Sub SubRun2
'will now have access to Var1 and Var2 as defined in SubRun1
End Sub

你甚至可以使用Sub的名字;你真的不需要'呼叫'部分。

VBA EXCEL：如何在另一个子程序中调用子程序？

2 个答案: