多個下圖的送貨單工作表法梯,數(shù)據(jù)條數(shù)不定校镐,需要全部合并在對賬單這個工作表
數(shù)據(jù)0
數(shù)據(jù)1
結果
結果
Sub 合并數(shù)據(jù)()
Dim arr, brr(1 To 1000, 1 To 12), i As Long, k As Long
Dim sht As Worksheet, LastRow As Long, LastRow1 As Long
For Each sht In Worksheets'遍歷工作表纯陨,將所有對帳單數(shù)據(jù)放到數(shù)組brr
If sht.Name <> "對帳單" Then
With sht
LastRow = .Range("c6:c1000").Find("總額大寫").Row - 1
arr = .Range("b6:L" & LastRow)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
k = k + 1
brr(k, 1) = k
For j = 2 To UBound(arr, 2) + 1
brr(k, j) = arr(i, j - 1)
Next
End If
Next
End With
End If
Next
m = k + 5
With Sheets("對帳單")'準備輸出brr數(shù)據(jù)到目標工作表
LastRow1 = .Range("c6:c1000").Find("總額大寫").Row - 1
.Range("a6:l" & LastRow1).ClearContents
If LastRow1 > m Then'如果數(shù)據(jù)條數(shù)比單元格存放區(qū)域少,刪除空白行
For ii = LastRow1 To m + 1 Step -1
.Rows(ii).Delete
Next
ElseIf LastRow1 < m Then'數(shù)據(jù)條數(shù)比單元格存放區(qū)域多碱蒙,插入行
n = m - LastRow1
For iii = 1 To n
.Rows(LastRow1).Insert
Next
Else'相等則轉到100:代碼處
GoTo 100
End If
100:
.Range("a6").Resize(k, 12) = brr'輸出合并的數(shù)據(jù)
End With
MsgBox "匯總完畢"
End Sub
示例文件下載:
鏈接: http://pan.baidu.com/s/1mhZpXNi 密碼: ptgi