VBA幫助。我正在尋找一次打開7個檔案的最佳方法（在過去的一周里 -有解無憂

下面是我的代碼，它在周二至周五打開昨天的檔案，在周一打開最近3天的檔案。現在需要做一個每周的版本，我覺得代碼可能會變得太長。是否有更好的方法來完成這個任務，而不是重新創建7次回圈？

我在想，我可以做另一個回圈，即當G列（只有在更新時才有資訊）為空時，在A列的相應單元格中獲取日期，并從A列的日期到昨天的日期不斷打開檔案？(圖片供我參考)所以它將填補從13/09/2021到19/09/2021的每一天。

圖片顯示A、B、F、G和H列。A列為日期，其余為統計資料

另外，由于我是VBA的新手，如果有人能指出如何使這段代碼更加健壯和/或高效，那就更好了。

Sub OpenManagersFileAndSelectColumns()

Dim目錄As String, fileName As String, sheet As Worksheet, total As Integer, directory3day As String, fileName3day As String, directory2day As String, fileName2day As String, DateStringFS As String, AlteryxFP As String.

' 關閉螢屏更新和顯示警報。
應用程式.ScreenUpdating = False
應用程式.DisplayAlerts = False

' 為目錄和檔案名創建動態元素。
    ' 創建年、日、月的年份。
    
        '對于-1天（在兩個地方使用）
        YearString = Format((Date - 1), "yyyy")
        MonthYearString = Format((Date - 1), "mmm yyyy")
        DateString = Format((Date - 1), "dd-mm-yyy")
        
        '為-2天。
        YearString2day = Format((Date - 2), "yyy")
        MonthYearString2day = Format((Date - 2), "mmm yyyy")
        DateString2day = Format((Date - 2), "dd-mm-yyy")

        '為-3天。
        YearString3day = Format((Date - 3), "yyy")
        MonthYearString3day = Format((Date - 3), "mmm yyyy")
        Dim DateString3day As String 

        '日期為檔案名
        DateStringFS = Format((Date), "dd.mm.yy")
 
    'Gets username of the device for comp and whether or not'。
    comp = Environ("username")

    '獲取Alteryx的輸出。
    If Environ("username") = "SP" Then
        AlteryxFP = "Alteryx輸出"
    Else
        AlteryxFP = "" Else
    End If
    
    


' 初始化變數目錄。我們使用Dir函式來查找存盤在該目錄下的第一個*.csv檔案。( 如果有必要，可以將其改為xls。
    'For Today - 1 day（在兩個地方使用）
    目錄 = "C:Users" & comp & "Dropbox（SHG）" & AlteryxFP & "Daily Finance & Revenue Data1. Daily Occupancy OutputSite 5" & YearString & " & MonthYearString & " & DateString & "
    
    '為今天-2天。
    directory2day = "C:Users" & comp & "Dropbox（SHG）" & AlteryxFP & "Daily Finance & Revenue Data1. Daily Occupancy OutputSite 5" & YearString2day & " & MonthYearString2day & " & DateString2day & "
    
    '為今天-3天。
    directory3day = "C:Users" & comp & "Dropbox（SHG）" & AlteryxFP & "Daily Finance & Revenue Data1. Daily Occupancy OutputSite 5" & MonthYearString3day & " & DateString3day & "。



'確保當前檔案被激活并清除之前的內容。

Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
張("實際資料").激活
Rows("4:7").Select。
選擇.清除內容

'如果它是一個星期一，那么它將打開最近的3天，它是一周的其他時間，它將打開前一天。
If Format(Date, "w") = 2 Then
    


    ' 今天-1天
    
    fileName = Dir(directory & "*manager*.csv"/span>)
    
    ' 變數fileName現在持有目錄中找到的第一個Excel檔案的名稱。添加一個Do While回圈。
    Do While fileName <> ""/span>

        ' 沒有簡單的方法可以從關閉的Excel檔案中復制作業表。因此，我們打開Excel檔案。
        Workbooks.Open (directory & fileName), local:=True
            
        ' 將Excel檔案中的作業表匯入到import-sheet.xls中。
        
        For Each sheet In Workbooks（fileName）.Worksheets
            總數 = 作業簿("YORYK每日報告" & DateStringFS & "$.xlsb").作業表.計數
            Windows(fileName).Activate
                
                ' 如果檔案中的日期是TODAY-1，則接受，否則有錯誤資訊。。
                  If Range("AG2") = (Date - 1) Then
                  
                    Rows("2:2").Select
                    選擇.復制
                    Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
                    表("實際資料").激活
                    Rows("7:7").Select。
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Application.CutCopyMode = False, Transpose:=False.
                    Range("A4:AG5").Select。
                    Application.CutCopyMode = False[/span]。
                    
                Else
            
                    MsgBox "檔案中的日期不符合" & DateString
                
                ' End If for checking the date for day - 1
                End If

                下一頁表
        
        '關閉Excel檔案。
        Workbooks(fileName).Close
        
        'Dir函式是一個特殊函式。要獲得其他的Excel檔案，你可以再次使用Dir函式，沒有引數。
        fileName = Dir()
        
        '注意：當沒有更多的檔案名匹配時，Dir函式回傳一個零長度的字串（""）。
        '因此，Excel VBA將離開Do While回圈。
    
    '一天的回圈結束--1個檔案打開并粘貼。
    
    
    Loop
    
    ' 今天--2天。
    
    fileName2day = Dir(directory2day & "*manager*.csv"/span>)
    
    ' 變數fileName現在持有目錄中找到的第一個Excel檔案的名稱。添加一個Do While回圈。
    Do While fileName2day <> ""/span>

        ' 沒有簡單的方法可以從關閉的Excel檔案中復制作業表。因此，我們打開Excel檔案。
        Workbooks.Open (directory2day & fileName2day), local:=True
        
        
        ' 將Excel檔案中的作業表匯入到這個作業表中。
        
        For Each Sheet In Workbooks(fileName2day).Worksheets
            總數 = 作業簿("YORYK每日報告" & DateStringFS & "$.xlsb").作業表.計數
            Windows(fileName2day).激活
                
                If Range("AG2") = Date - 2 Then >。
                  
                    Rows("2:2").Select
                    選擇.復制
            
                    張("實際資料").激活
                    Rows("6:6").Select。
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Application.CutCopyMode = False, Transpose:=False.
                
                Else
            
                    MsgBox "檔案中的日期不匹配" & DateString2day
            
                End If
        
        Next表
        
        '關閉Excel檔案。
        Workbooks(fileName2day).Close
        
        'Dir函式是一個特殊函式。要獲得其他的Excel檔案，你可以再次使用Dir函式，沒有引數。
        fileName2day = Dir()
        
        '注意：當沒有更多的檔案名匹配時，Dir函式回傳一個零長度的字串（""）。
        '因此，Excel VBA將離開Do While回圈。

    Loop


    ' 今天 - 3天
    
    fileName3day = Dir(directory3day & "*manager*.csv"/span>)
    
    ' 變數fileName現在持有目錄中找到的第一個Excel檔案的名稱。添加一個Do While回圈。
    Do While fileName3day <> ""/span>

        ' 沒有簡單的方法可以從關閉的Excel檔案中復制作業表。因此，我們打開Excel檔案。
        Workbooks.Open (directory3day & fileName3day), local:=True
        
        
        ' 將Excel檔案中的作業表匯入import-sheet.xls.。
        
        For Each sheet In Workbooks（fileName3day）.Worksheets
            總數 = 作業簿("YORYK每日報告" & DateStringFS & "$.xlsb").作業表.計數
            Windows(fileName3day).激活
            
            '如果檔案中的日期是TODAY - 3，那么接受并粘貼資訊，否則會有錯誤資訊。。
                  
            If Range("AG2") = Date - 3 Then
                  
                Rows("1:2").Select
                選擇.復制
                Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
                表("實際資料").激活
                Rows("4:5").Select。
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False, Transpose:=False.
            
            Else
            
                MsgBox "檔案中的日期不匹配" & DateString3day
            
            ' End If for day - 3
            End If
    
        下一頁表
        
        '關閉Excel檔案。
        Workbooks(fileName3day).Close
        
        'Dir函式是一個特殊函式。要獲得其他的Excel檔案，你可以再次使用Dir函式，沒有引數。
        fileName3day = Dir()
        
        '注意：當沒有更多的檔案名匹配時，Dir函式回傳一個零長度的字串（""）。
        '因此，Excel VBA將離開Do While回圈。


    'End Loop for Today - 3
    Loop

   
    ' 回圈結束，現在清洗資料，為3天部分。
    ' 下一步是選擇正確的資料列并進行計算，以獲得3天內的TR、RR、OCC、OOO、ADR。

    Range("A4:AF7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("K4:AD7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AE4:DO7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AF4:AT7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AH4:CE7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Columns("AE:AG").Select。
    選擇.切割
    Columns("C:C").Select。
    Select.INSERT Shift:=xlToRight
    Columns("F:M").Select。
    Selection.INSERT Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
    表("實際資料").激活
    Columns("A:A").Select。
    Selection.NumberFormat = "m/d/yyyy"/span>.
    
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "Rms".
    Range("H4").Select。
    ActiveCell.FormulaR1C1 = "G Rms"。
    Range("I4").Select。
    ActiveCell.FormulaR1C1 = "Rm Rev".
    Range("J4").Select。
    ActiveCell.FormulaR1C1 = "ADR"。
    Range("K4").Select。
    ActiveCell.FormulaR1C1 = "OOO Rms"。
    Range("L4").Select。
    ActiveCell.FormulaR1C1 = "Total Rev".
    
    Range("G5").Select。
    ActiveCell.FormulaR1C1 = "=RC[-4] RC[-3]" 
    Range("I5").Select。
    ActiveCell.FormulaR1C1 = "=RC[-7]-RC[13]"。
    Range("J5").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-3]" 
    Range("K5").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]"。
    Range("L5").Select。
    ActiveCell.FormulaR1C1 = "=SUM(RC[-10],RC[2]:RC[9])-SUM(RC[10]:RC[29])"
    Range("G5:L5").Select
    Selection.AutoFill Destination:=Range("G5:L7"), Type:=xlFillDefault
    Range("G5:L7").Select。
    Range("G4").Select。
       
' 為標題著色，以獲得通知它已經完成。

    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 65535
        .TintAndShade = 00
    結束 有
    ActiveCell.FormulaR1C1 = "Rms"/span>

    Range("H4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "G Rms"/span>

    Range("I4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "Rm Rev"/span>

    Range("J4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "ADR"/span>

    Range("K4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "OOO Rms"/span>

    Range("L4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    
    ActiveCell.FormulaR1C1 = "Total Rev" 
    Range("G4:L4").Select
    With Selection.Interior
        .圖案 = xlSolid
        .圖案顏色索引 = xlAutomatic
        .主題色 = xlThemeColorAccent6
        .TintAndShade =0
        .PatternTintAndShade = 0結束 有
    


' This else is for days where day does not = monday, so any other day of the week. 

Else
    fileName = Dir(directory & "*manager*.csv"/span>)
    
    ' 變數fileName現在持有目錄中找到的第一個Excel檔案的名稱。添加一個Do While回圈。
    Do While fileName <> ""/span>

        ' 沒有簡單的方法可以從關閉的Excel檔案中復制作業表。因此，我們打開Excel檔案。
        Workbooks.Open (directory & fileName), local:=True
        
        
        ' 將預測檔案中的作業表匯入此作業表。
        
        For Each sheet In Workbooks（fileName）.Worksheets
            總數 = 作業簿("YORYK每日報告" & DateStringFS & "$.xlsb").作業表.計數
            Windows(fileName).Activate
                   
            If Range("AG2") = Date - 1 Then >。

                Rows("1:2").Select
                選擇.復制
                Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
                表("實際資料").激活
                Rows("4:5").Select。
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False, Transpose:=False.
            Else
            
                    MsgBox "檔案中的日期不符合" & DateString
        
            End If
    
        Next表
        
        '關閉Excel檔案。
        Workbooks(fileName).Close
        
        
        'Dir函式是一個特殊函式。要獲得其他的Excel檔案，你可以再次使用Dir函式，沒有引數。
        fileName = Dir()
        
        '注意：當沒有更多的檔案名匹配時，Dir函式回傳一個零長度的字串（""）。
        '因此，Excel VBA將離開Do While回圈。

    Loop
    
    ' 回圈結束，為1天設定，現在清理資料。
    ' 下一步是選擇正確的資料列并進行計算，以獲得一天的TR、RR、OCC、OOO、ADR。

    Range("A4:AF7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("K4:AD7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AE4:DO7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AF4:AT7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Range("AH4:CE7").Select。
    選擇.洗掉 Shift:=xlToLeft
    Columns("AE:AG").Select。
    選擇.切割
    Columns("C:C").Select。
    Select.INSERT Shift:=xlToRight
    Columns("F:M").Select。
    Selection.INSERT Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Windows("YORYK Daily Report" & DateStringFS & "$.xlsb") .激活
    表("實際資料").激活
    Columns("A:A").Select。
    Selection.NumberFormat = "m/d/yyyy"/span>.
    
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "Rms".
    Range("H4").Select。
    ActiveCell.FormulaR1C1 = "G Rms"。
    Range("I4").Select。
    ActiveCell.FormulaR1C1 = "Rm Rev".
    Range("J4").Select。
    ActiveCell.FormulaR1C1 = "ADR"。
    Range("K4").Select。
    ActiveCell.FormulaR1C1 = "OOO Rms"。
    Range("L4").Select。
    ActiveCell.FormulaR1C1 = "Total Rev".
    
    Range("G5").Select。
    ActiveCell.FormulaR1C1 = "=RC[-4] RC[-3]" 
    Range("I5").Select。
    ActiveCell.FormulaR1C1 = "=RC[-7]-RC[13]"。
    Range("J5").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-3]" 
    Range("K5").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]"。
    Range("L5").Select。
    ActiveCell.FormulaR1C1 = "=SUM(RC[-10],RC[2]:RC[9])-SUM(RC[10]:RC[29])"

    '彩色標題，為每個標題標明其已完成，為期一天。
    
    Range("G4").Select
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "Rms"/span>

    Range("H4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "G Rms"/span>

    Range("I4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "Rm Rev"/span>

    Range("J4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "ADR"/span>

    Range("K4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "OOO Rms"/span>

    Range("L4").Select。
    With Selection.Interior
        .圖案 = xlSolid
        .PatternColorIndex = xlAutomatic
        .顏色 = 6553500
    結束 有
    ActiveCell.FormulaR1C1 = "Total Rev" 
    
    Range("G4:L4").Select
    With Selection.Interior
        .圖案 = xlSolid
        .圖案顏色索引 = xlAutomatic
        .主題色 = xlThemeColorAccent6
        .TintAndShade =0
        .PatternTintAndShade = 0結束 有

' End If for -1 day vs - 3 day.
End If



'打開螢屏更新并再次顯示警報（在回圈之外）。
應用程式.ScreenUpdating = True
應用程式.DisplayAlerts = True

End Sub

uj5u.com熱心網友回復：

你的問題的答案是：是的，你可能應該改變你的代碼，以便在日期串列中作業，這樣它就會被資料驅動。此外，你的代碼可以從更好地使用vba中獲益良多，你可以學習：

正如評論中指出的，在你的vba代碼中使用變數來訪問作業簿、作業表和單元格范圍，而不是使用Activate和Select--只有當你需要改變用戶看到的內容時才應該使用，即使如此，也只能在處理的最后，在將控制權交還給用戶之前使用。你的代碼將更容易閱讀，運行速度也更快。

。

使用命名的格式化樣式而不是硬編碼樣式。這更有意義，而且如果你想改善你的作業簿的外觀而不需要改變vba代碼的話，更容易改變和擴展。

將代碼分割成做特定邏輯部分的函式，并呼叫這些函式而不是重復代碼。如果你使用變數來指代作業簿、作業表等，那么你可以將變數傳遞給函式。例如，處理一個csv檔案的代碼可以寫成一個函式，由高層邏輯呼叫。

我想你會發現，你的代碼變得簡單了許多，也更容易閱讀和理解。

uj5u.com熱心網友回復：

請嘗試下一段代碼。當然，它沒有經過測驗，但它的邏輯應該是正確應用的。它打開每個csv檔案，并從第7行開始向后復制其第二行到報告中：

Sub tes7DaysBackArray()
   Dim arr7D, arrM, arrY, d As Date, DateStringFS As String, wsAD As 作業表, wbLoc As 作業簿, AlteryxFP As String.
   Dim pathRoot As String, fileName As String, comp As String, ws As 作業表。i As Long, iRow As Long.
   
  
   DateStringFS = Format((Date), "dd.mm.yy") : d = Date: iRow = 7
   '建立包含必要的格式化字串的陣列：。
   arr7D = Application. Transpose(Evaluate("TEXT(DATE(" & Year(d - 7) & ", " & month(d - 7) & ",row("/span> & Day(d - 7) & " 。 " & Day(d - 1) & "),""dd-mm-yyy"") "))
   arrM = Application. Transpose(Evaluate("TEXT(DATE(" & Year(d - 7) & "，" & month(d - 7) & ",row("/span> & Day(d - 7) & " 。 " & Day(d - 1) & "),""mmm yyy")")
   arrY = 應用程式。 Transpose(Evaluate("TEXT(DATE(" & Year(d - 7) & "，" & month(d - 7) & ",row("/span> & Day(d - 7) & " 。 " & Day(d - 1) & "),""yyyy")"))
   Debug.Print Join(arr7D, "|")。Debug.Print Join(arrM, "|") 。Debug.Print Join(arrY, "|") 'just to visually see the above built arrays.../span>
   
    If Environ("username") = "SP" Then
        AlteryxFP = "Alteryx輸出"
    Else
        AlteryxFP = "" Else
    End If
     pathRoot = "C:Users" & comp & "Dropbox（SHG）" & AlteryxFP & "Daily Finance & Revenue Data1. 每日占有率輸出站點5"
   Set wsAD = Workbooks("YORYK Daily Report" & DateStringFS & "$.xlsb").Sheet("actual data")
   For i = 0 To UBound(arr7D)
        fileName = pathRoot & arrY(i) & " & arrM(i) & " & arr7D(i) & "
                                                                                         
        fileName = dir(fileName & "*manager*.csv")
        If fileName <> ""/span> Then
            Set wbLoc = Workbooks.Open(Directory & fileName, local:=True)
            Set ws = wbLoc.Sheet(1) 'the single existing sheet。
             If CStr(Format(ws.Range("AG2"/span>). Value, "dd-mm-yyy") = arr7D(i) Then
                    wsAD.rows(iRow & ":" & iRow).Value = ws.rows("2:2").Value: iRow = iRow   1.
                    wbLoc.CloseFalse。
             Else[/span
                    MsgBox "檔案中的日期不匹配"  & arr7D(i)
             End If
        Else
            MsgBox "No any required csv file could be found in & "" & fileName & ""。" 
        End If
   Next i
End Sub

轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/323579.html

標籤：

上一篇：賦予變數的兩種方法之間的區別ExcelVBA

下一篇：運行時錯誤91：物件變數或與塊變數未設定