用工作表名稱轉置

Question

我有VBA代碼，可以在電子表格中轉置數據，以便可以將其輸入另一個程序。 以下代碼需要根據工作表名稱在電子表格中的多個工作表中執行。

手動輸入工作表名稱時，代碼可以正確執行，但是，由於我要添加一個數組，因此當我嘗試執行代碼時收到錯誤消息； 該錯誤顯示為“類型不匹配”，並在下面的箭頭所在的行上發生。

如果有人可以幫助，我將不勝感激！ 我認為問題是與工作表名稱的讀取方式有關，但是，作為VBA的新用戶，我在解決問題時遇到了問題：

Sub LoopThroughSheets()

Dim Sheets As Variant
Dim Sheet As Variant

Sheets = Array("Sheet4.3")

For Each Sheet In Sheets
    'Code goes here.

Dim ws As Worksheet
Dim i, k, multiple As Integer
Dim rawrowcount As Long
Dim rawcolcount As Long
    'Define variables for the below-noted code

For i = 1 To ActiveWorkbook.Sheets.Count
    If ActiveWorkbook.Sheets(i).Name = "Q_" & Sheets Then <-- <-- <-- <--
        ActiveWorkbook.Sheets(i).Delete
    End If
Next i
    'Delete Worksheet if already existing for respective tab

With ThisWorkbook
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    ws.Name = "Q_" & Sheets
    ws.Range("A1").Value = "Year"
    ws.Range("B1").Value = "Product"
    ws.Range("C1").Value = "Product Type"
    ws.Range("D1").Value = "Cashflow"
End With
    'Insert column headings for Resulting spreadsheet

With ThisWorkbook.Sheets("4.3")
    '.Range("I:I").Delete
    .Range("A:A").Delete
    '.Rows(111).Delete
    rawrowcount = WorksheetFunction.CountA(.Range("A:A")) - WorksheetFunction.CountA(.Range("A1:A10")) - 1
    rawcolcount = .Cells(10, Columns.Count).End(xlToLeft).Column - 2
End With
'Count the number of rows and columns to determine how many the number of iterations
'for the next set of code

Application.ScreenUpdating = False
    'Do not update screen while executing code

For i = 1 To rawcolcount
    multiple = rawrowcount * (i - 1)
    For k = 1 To rawrowcount
        'Sheets("4.3").Activate
        'ActiveSheet.Range("A9").Select
        'Selection.Offset(k + 1, 0).Select
        'Selection.Copy
        'Sheets("Q_" & Sheets).Activate
        'ActiveSheet.Range("A1").Select
        'Selection.Offset(k + multiple, 0).Select
        'ActiveSheet.Paste
            'Copy and paste Years 1 to 100

        Sheets("4.3").Activate
        ActiveSheet.Range("A9").Select
        Selection.Offset(k + 1, i).Select
        Selection.Copy
        Sheets("Q_" & Sheets).Activate
        ActiveSheet.Range("A1").Select
        Selection.Offset(k + multiple, 3).Select
        ActiveSheet.Paste
            'Copy and paste the Cashflow for Years 1 to 100 for
            'each Product

    Next k
        'Repeat for each Product Type


    Sheets("4.3").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(2, 0).Select
    Selection.Copy
    Sheets("Q_" & Sheets).Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 0).Select
    ActiveSheet.Paste
        'Copy & paste the Year for each respective Cashflow

    'Sheets("Q_" & Sheets).Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 1).Value = "Canada Region"
        'Copy & paste Region for the respective Cashflow

    Sheets("4.3").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(1, i).Select
    Selection.Copy
    Sheets("Q_" & Sheets).Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 1).Select
    ActiveSheet.Paste
        'Copy & paste the Product for each respective Cashflow

    Sheets("4.3").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(0, i).Select
    Selection.Copy
    Sheets("Q_" & Sheets).Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 2).Select
    ActiveSheet.Paste
        'Copy & paste the Product Type for each respective Cashflow

    'Sheets("4.3").Activate
    'ActiveSheet.Range("B8").Select
    'Selection.Offset(0, i).Select
    'Selection.Copy
    'Sheets("Q_" & Sheets).Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 4).Select
    'ActiveSheet.Paste
        'Copy & paste Risk for the respective Cashflow

    ActiveSheet.Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 2, 3)).Select
    Selection.AutoFill Destination:=Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 101, 3))
        'Autofill the Region, Product and Product Type for each Cashflow

Next i
    'Repeat for Years 1 to 100

Application.ScreenUpdating = False
    'Do not update screen while executing code

Call Delete
    'Call the next subroutine (Delete)


ThisWorkbook.ActiveSheet.Cells.ClearFormats
    'Clear formatting in Output Worksheet

Set ws = Nothing

Next Sheet
End Sub

Answer 1

無需對照數組中的名稱檢查工作簿中的每個工作表名稱，您只需將要刪除的名稱加載到數組中，然后將其刪除（使用On Error Resume Next語句忽略其中工作表不存在）。

這有可能變得更有效率，因為您不會循環瀏覽工作簿中的每個工作表，而只會循環瀏覽要刪除的工作表（如果它們已經存在）。

另外，請不要命名與Excel對象名稱（如Sheets）一致的變量。

Dim aSheets() as Variant
'Dim aSheets() as String 'alternate approach

aSheets = Array("Sheet4.3","Sheet4.4","Sheet4.5") 'extra added as example
'aSheets = Split("Sheet4.3,Sheet4.4,Sheet4.5",",") 'alternate approach

Dim x as Integer
On Error Resume Next ' will ignore instances where sheet is not in workbook
For x = LBound(aSheets) to UBound(aSheets)

    Worksheets("Q_" & aSheets(x)).Delete

Next
On Error GoTo 0 'resets error catch so any errors in further code will appear