处理excel中数据库式重复行的合并问题

impish0

直接举例说明吧，在此只是为了留个记录

表头1	表头2	表头3	表头4
A	B	C	F
A	B	D	G
A	B	E	H

处理成

表头1	表头2	表头3	表头4	表头5	表头6	表头7	表头8	表头9	表头10
A	B	C	F	D	G	E	H

1. Sub MergeValuesBasedOnColumnA()
   
2. 
   
3.     Dim ws As Worksheet
   
4. 
   
5.     Set ws = ThisWorkbook.Sheets("Sheet1")
   
6. 
   
7.     Dim lastRow As Long
   
8. 
   
9.     lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
10. 
    
11.     Dim dict As Object
    
12. 
    
13.     Set dict = CreateObject("Scripting.Dictionary")
    
14. 
    
15.     Dim i As Long
    
16. 
    
17.     Dim key As Variant
    
18. 
    
19.     Dim valueList As Collection
    
20. 
    
21.     ' 遍历2列
    
22. 
    
23.     Temp = ""
    
24. 
    
25.     For i = 2 To lastRow
    
26. 
    
27.         For j = i To lastRow
    
28. 
    
29.             If (Cells(j, 2) <> Cells(j + 1, 2)) Then Exit For
    
30. 
    
31.         Next j
    
32. 
    
33.    
    
34. 
    
35. 
    
36. 
    
37.         For k = i To j
    
38. 
    
39. 
    
40. 
    
41.             Cells(j, 39 + 2 * (k - i)) = Cells(k, 15).Value
    
42. 
    
43.             Cells(j, 39 + 2 * (k - i) + 1) = Cells(k, 17).Value
    
44. 
    
45.             
    
46. 
    
47.             
    
48. 
    
49.         Next k
    
50. 
    
51.         i = j
    
52. 
    
53. '        If (Cells(i, 2) = Cells(i + 1, 2)) Then
    
54. 
    
55. '
    
56. 
    
57. '            k = i
    
58. 
    
59. '            Cells(k, 39 + i - k) = Cells(i, 15).Value
    
60. 
    
61. '            Cells(k, 39) = Cells(i, 15).Value
    
62. 
    
63. '            Temp = Cells(i, 15).Value & Cells(i, 17).Value
    
64. 
    
65. '        Else
    
66. 
    
67. '
    
68. 
    
69. '            k = i
    
70. 
    
71. '            Cells(i, 18) = Temp & Chr(10) & Cells(i, 15).Value & Cells(i, 17).Value
    
72. 
    
73. '
    
74. 
    
75. '            Temp = ""
    
76. 
    
77. '
    
78. 
    
79. '        End If
    
80. 
    
81.     Next i
    
82. 
    
83. 
    
84. 
    
85. End Sub
    
86. 
    
87. 
    
88. 
    

复制代码

用到了双for循环，以及循环变量的阶段跳跃处理，注释掉的是合并到同单元格处理方式。思路仅供参考

shiruiqiang

字典处理一下就行

清风竹-

Sub 重复行合并()
Dim arr, d, i, j, n
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet2.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
    For j = 1 To UBound(arr, 2)
       If Not d.Exists(arr(i, j)) Then
          n = n + 1
          d.Add arr(i, j), "表头" & n
       End If
    Next
Next
[a1].Offset(UBound(arr) + 6, 0).Resize(1, d.Count) = d.keys
[a1].Offset(UBound(arr) + 5, 0).Resize(1, d.Count) = d.items
End Sub