使用工作表名称转置

时间:2016-01-08 18:18:21

标签: arrays vba excel-vba transpose excel

我有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

1 个答案:

答案 0 :(得分:0)

您可以简单地将要删除的名称加载到数组中,然后将其删除(使用On Error Resume Next语句忽略任何名称)工作表不存在的实例)。

这有可能提高效率,因为您不会遍历工作簿中的每个工作表,而只会遍历要删除的工作表(如果已经存在)。

另外,请远离命名与Excel对象名称(如表格)一致的变量。

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
相关问题