我有在活动工作表中可用的代码,但是当我尝试添加到代码中以使其遍历除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