Excel VBA遍历除2以外的所有工作表-在单独的工作表中粘贴数组

时间:2018-09-20 22:18:21

标签: excel vba excel-vba

我有在活动工作表中可用的代码,但是当我尝试添加到代码中以使其遍历除2外的所有工作表时,出现错误并且无法弄清楚如何解决它。代码遍历时间卡,在工作卡的左侧列出工作编号,日期紧靠顶部,每个日期分别带有reg,OT和DT列,然后拉出每个日期下的小时数,并将其放入Sheet3的单独行中格式为.csv上传文件。我需要为除2之外的所有工作表运行代码,工作表数可以根据所需的时间卡数而变化。我知道我的工作代码引用了活动工作表,并且循环不会激活每个工作表,因此我尝试对此进行调整。我的问题可能出在我做事的顺序上。我是VBA的初学者,主要只是为了满足我的需要调整其他人的代码。我尝试过在线查找解决方案,但它们似乎无法解决我的问题。我已经为此工作了2天,因此非常感谢您的帮助。

工作代码:

Sub CreateCSV()
Dim wsTC As Worksheet, wsCSV As Worksheet
Dim tcAr As Variant, csvAr As Variant
Dim i As Long, k As Long

Set wsTC = ActiveWorkbook.ActiveSheet: Set wsCSV = Sheet3

With wsTC
    '~~> Store the values from the range in an array
    tcAr = .Range("A12:AC25").Value

    '~~> Define your new array
    ReDim csvAr(1 To 29, 1 To 14)

    '~~> Loop through the array and store values in new array
    For i = LBound(tcAr) To UBound(tcAr)

        '~~> Check for Mon Reg
        If tcAr(i, 6) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 6)   'Hours
        End If

        '~~> Check for Mon OT
        If tcAr(i, 7) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 7)   'Hours
        End If

        '~~> Check for Mon DT
        If tcAr(i, 8) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 8)   'Hours
        End If

        '~~> Check for Mileage
        If tcAr(i, 27) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[X8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase            
            csvAr(k, 13) = tcAr(i, 27) * 0.35   'Amount
            csvAr(k, 14) = tcAr(i, 29)   'Memo
        End If

    Next i
End With

    '~~> Output the array
    wsCSV.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(29, 14).Value = csvAr

End Sub

无效代码:

Sub TestLoopCreateCSV()
Dim wsTC As Worksheet, wsCSV As Worksheet
Dim tcAr As Variant, csvAr As Variant
Dim i As Long, k As Long

Set wsCSV = Sheet3

For Each wsTC In ThisWorkbook.Worksheets

With wsTC

If wsTC.Name <> "Sheet2" And wsTC.Name <> "Sheet3" Then

    '~~> Store the values from the range in an array
    tcAr = .Range("A12:AC25").Value

    '~~> Define your new array
    ReDim csvAr(1 To 29, 1 To 14)

    '~~> Loop through the array and store values in new array
    For i = LBound(tcAr) To UBound(tcAr)

        '~~> Check for Mon Reg
        If tcAr(i, 6) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 6)   'Hours
        End If

        '~~> Check for Mon OT
        If tcAr(i, 7) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 7)   'Hours
        End If

        '~~> Check for Mon DT
        If tcAr(i, 8) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[F8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 12) = tcAr(i, 8)   'Hours
        End If

        '~~> Check for Mileage
        If tcAr(i, 27) <> "" Then
            k = k + 1
            csvAr(k, 1) = "1"           'Company
            csvAr(k, 2) = wsTC.[R6]     'PR End Date
            csvAr(k, 3) = wsTC.[D6]     'Employee
            csvAr(k, 4) = wsTC.[X8]     'Post Date
            csvAr(k, 5) = tcAr(i, 1)    'Job
            csvAr(k, 6) = tcAr(i, 3)    'Phase
            csvAr(k, 13) = tcAr(i, 27) * 0.35   'Amount
            csvAr(k, 14) = tcAr(i, 29)   'Memo
        End If

    Next i

    '~~> Output the array
    wsCSV.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(29, 14).Value = csvAr

    End If

    End With

Next wsTC

End Sub

0 个答案:

没有答案