[已解决]如何将EXCEL中三个工作表（收款，付款，付息）合并成最后一个汇总表

圣媛

按人名，把三个工作表：收款，付款，付息，合并成——汇总表里这样的格式。
每个工作表年份都是同一年的。但同个人名不是三个工作表都有。

最佳答案

月排行榜 / 总排行榜

cbg2008

2014-6-28 23:43

1. Sub huizong()
   
2.     Dim arrTemp, arrTemp1, arrTemp2
   
3.     Dim arrRow(1 To 3)
   
4.     Dim arrOutput(1 To 5000, 1 To 7)
   
5.     Dim d As Object
   
6.     Dim arrKeys
   
7.     Dim arrItems
   
8.     Dim i As Long, j As Long
   
9.     Dim lngColumn As Long, lngRow As Long
   
10.     Dim sht As Worksheet
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For Each sht In Sheets
    
13.         If InStr("收款付款付息", sht.Name) > 0 Then
    
14.             lngColumn = (InStr("收款付款付息", sht.Name) + 1) / 2
    
15.             arrTemp = sht.UsedRange
    
16.             For i = 2 To UBound(arrTemp)
    
17.                 If arrTemp(i, 2) <> "" Then
    
18.                     d(arrTemp(i, 2)) = d(arrTemp(i, 2)) & ";" & lngColumn & "," & arrTemp(i, 1) & "," & arrTemp(i, 3)
    
19.                 End If
    
20.             Next i
    
21.         End If
    
22.     Next sht
    
23.     arrKeys = d.keys
    
24.     arrItems = d.items
    
25.     Set d = Nothing
    
26.     For i = 0 To UBound(arrKeys)
    
27.         arrOutput(lngRow + 1, 1) = arrKeys(i)
    
28.         arrTemp1 = Split(arrItems(i), ";")
    
29.         For j = 1 To UBound(arrTemp1)
    
30.             arrTemp2 = Split(arrTemp1(j), ",")
    
31.             arrRow(arrTemp2(0)) = arrRow(arrTemp2(0)) + 1
    
32.             arrOutput(arrRow(arrTemp2(0)), arrTemp2(0) * 2) = CDate(arrTemp2(1))
    
33.             arrOutput(arrRow(arrTemp2(0)), arrTemp2(0) * 2 + 1) = Val(arrTemp2(2))
    
34.         Next j
    
35.         lngRow = WorksheetFunction.Max(arrRow(1), arrRow(2), arrRow(3))
    
36.         arrRow(1) = lngRow
    
37.         arrRow(2) = lngRow
    
38.         arrRow(3) = lngRow
    
39.     Next i
    
40.     With Sheets("汇总表")
    
41.         .Cells.Clear
    
42.         .Range("A1:G1") = Array("姓名", "收款日期", "收款金额", "付款日期", "付款金额", "付息日期", "付息金额")
    
43.         .Range("A2").Resize(lngRow - 1, 7) = arrOutput
    
44.         With .Range("A2").Resize(lngRow - 1, 7)
    
45.             .Columns(3).NumberFormatLocal = "#,##0.00"
    
46.             .Columns(5).NumberFormatLocal = "#,##0.00"
    
47.             .Columns(7).NumberFormatLocal = "#,##0.00"
    
48.             .Columns(2).NumberFormatLocal = "e/mm/dd"
    
49.             .Columns(4).NumberFormatLocal = "e/mm/dd"
    
50.             .Columns(6).NumberFormatLocal = "e/mm/dd"
    
51.         End With
    
52.         With .Range("A1").Resize(lngRow, 7)
    
53.             .Borders.Weight = xlThin
    
54.             .EntireColumn.AutoFit
    
55.         End With
    
56.     End With
    
57. End Sub

复制代码

表A.rar (36.54 KB, 下载次数: 18)

2014-6-28 23:43 上传

点击文件名下载附件

跳转到最佳答案楼层

cbg2008

1. Sub huizong()
   
2.     Dim arrTemp, arrTemp1, arrTemp2
   
3.     Dim arrRow(1 To 3)
   
4.     Dim arrOutput(1 To 5000, 1 To 7)
   
5.     Dim d As Object
   
6.     Dim arrKeys
   
7.     Dim arrItems
   
8.     Dim i As Long, j As Long
   
9.     Dim lngColumn As Long, lngRow As Long
   
10.     Dim sht As Worksheet
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For Each sht In Sheets
    
13.         If InStr("收款付款付息", sht.Name) > 0 Then
    
14.             lngColumn = (InStr("收款付款付息", sht.Name) + 1) / 2
    
15.             arrTemp = sht.UsedRange
    
16.             For i = 2 To UBound(arrTemp)
    
17.                 If arrTemp(i, 2) <> "" Then
    
18.                     d(arrTemp(i, 2)) = d(arrTemp(i, 2)) & ";" & lngColumn & "," & arrTemp(i, 1) & "," & arrTemp(i, 3)
    
19.                 End If
    
20.             Next i
    
21.         End If
    
22.     Next sht
    
23.     arrKeys = d.keys
    
24.     arrItems = d.items
    
25.     Set d = Nothing
    
26.     For i = 0 To UBound(arrKeys)
    
27.         arrOutput(lngRow + 1, 1) = arrKeys(i)
    
28.         arrTemp1 = Split(arrItems(i), ";")
    
29.         For j = 1 To UBound(arrTemp1)
    
30.             arrTemp2 = Split(arrTemp1(j), ",")
    
31.             arrRow(arrTemp2(0)) = arrRow(arrTemp2(0)) + 1
    
32.             arrOutput(arrRow(arrTemp2(0)), arrTemp2(0) * 2) = CDate(arrTemp2(1))
    
33.             arrOutput(arrRow(arrTemp2(0)), arrTemp2(0) * 2 + 1) = Val(arrTemp2(2))
    
34.         Next j
    
35.         lngRow = WorksheetFunction.Max(arrRow(1), arrRow(2), arrRow(3))
    
36.         arrRow(1) = lngRow
    
37.         arrRow(2) = lngRow
    
38.         arrRow(3) = lngRow
    
39.     Next i
    
40.     With Sheets("汇总表")
    
41.         .Cells.Clear
    
42.         .Range("A1:G1") = Array("姓名", "收款日期", "收款金额", "付款日期", "付款金额", "付息日期", "付息金额")
    
43.         .Range("A2").Resize(lngRow - 1, 7) = arrOutput
    
44.         With .Range("A2").Resize(lngRow - 1, 7)
    
45.             .Columns(3).NumberFormatLocal = "#,##0.00"
    
46.             .Columns(5).NumberFormatLocal = "#,##0.00"
    
47.             .Columns(7).NumberFormatLocal = "#,##0.00"
    
48.             .Columns(2).NumberFormatLocal = "e/mm/dd"
    
49.             .Columns(4).NumberFormatLocal = "e/mm/dd"
    
50.             .Columns(6).NumberFormatLocal = "e/mm/dd"
    
51.         End With
    
52.         With .Range("A1").Resize(lngRow, 7)
    
53.             .Borders.Weight = xlThin
    
54.             .EntireColumn.AutoFit
    
55.         End With
    
56.     End With
    
57. End Sub

复制代码

表A.rar (36.54 KB, 下载次数: 18)

2014-6-28 23:43 上传

点击文件名下载附件

圣媛

cbg2008 发表于 2014-6-28 23:43

可是这些我不懂。从1到57的代码，我都不知道该输到哪里？我连函数都很少用。
还有，对于不同表格，同格式的，也是输入这些代码吗？因为我有这样的表格9个，每个表都有几千行。

圣媛

cbg2008 发表于 2014-6-28 23:43

你好，还想请问下，还有别的办法吗？不用这么复杂的代码？因为我不知道，这些代码在用于其他表时，还需要修改其中的代码吗？

cbg2008

圣媛 发表于 2014-6-30 18:47
你好，还想请问下，还有别的办法吗？不用这么复杂的代码？因为我不知道，这些代码在用于其他表时，还需要 ...

有个比较简单的办法，那就是把表格手工合并，然后做透视表，复制到空白表格后，略微调整一下

cbg2008

圣媛 发表于 2014-6-30 18:47
你好，还想请问下，还有别的办法吗？不用这么复杂的代码？因为我不知道，这些代码在用于其他表时，还需要 ...

你看看附件中的扩展名是xlsx的文件，这是全手工的，都是你会的技巧，稍微麻烦点了。 表A.rar (43.05 KB, 下载次数: 5)

2014-6-30 20:01 上传

点击文件名下载附件