2016-12-29 74 views
0
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,我無法在宏中使用它。 有一點幫助真的很感激。 非常感謝你提前:) :)VBA EXCEL:如何在另一個子程序中調用子程序?

回答

2

你需要保持你的例程分開,然後從另一個調用一個。

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

Sub DoSomething() 
    Beep 
End Sub 
0

你只要這樣做。

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的名稱;你並不需要「呼叫」部分。

+0

'調用'陳述已過時,應該避免。 – ThunderFrame