VBA 资料合并整理( 有点难度 )

fzxba

On_fire 发表于 2024-3-30 19:04
老师好,
试了几个值, 都报错了,
可能要把New页的A列字符相同的行, 先合并…

On_fire

fzxba 发表于 2024-3-30 19:41

老师好,
请看看截图, 跟您报告一下,
尝试了列数一千又一千地增加,
如列数=15000, 会报错, 内存溢出
如列数=14000, 会报错, 下标越界

再次感谢老师, 祝您安康吉祥…

baofa2

1. Sub test0()
   
2.   
   
3.   Dim dict(2) As New Dictionary
   
4.   Dim New_, Key_, rebuilt(), pos ', sComp As String
   
5.   Dim i As Long, j As Long, x As Long, y As Long, s As String
   
6.   Dim rowSize As Long, colSize As Long, cnt As Long
   
7.   
   
8.   s = "|"
   
9.   With Sheet1
   
10.     i = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
    
11.     j = .Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
    
12.     New_ = .Range("A1").Resize(i, j).Value
    
13.   End With
    
14.   
    
15.   With Sheet2
    
16.     y = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
    
17.     x = .Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
    
18.     Key_ = .Range("A1").Resize(y, x).Value
    
19.   End With
    
20.   
    
21.   Sheet3.Activate
    
22.   Cells.Clear 'Contents
    
23.   
    
24.   ReDim rebuilt(1 To 12000, 1 To 10000)
    
25.   For i = 1 To UBound(New_)
    
26.     dict(0)(New_(i, 1)) = dict(0)(New_(i, 1)) & s & i
    
27.     dict(1).Add i, ""
    
28.   Next
    
29.   
    
30.   For i = 1 To UBound(Key_)
    
31.     dict(2).RemoveAll
    
32.     rowSize = rowSize + 1
    
33.     cnt = 0
    
34.     For j = 1 To UBound(Key_, 2)
    
35.       If Len(Key_(i, j)) Then
    
36.         If Not dict(2).Exists(Key_(i, j)) Then
    
37.           cnt = cnt + 1
    
38.           rebuilt(rowSize, cnt) = Key_(i, j)
    
39.           dict(2).Add Key_(i, j), ""
    
40.         End If
    
41.         If dict(0).Exists(Key_(i, j)) Then
    
42.           pos = Split(dict(0)(Key_(i, j)), s)
    
43.           For y = pos(1) To pos(UBound(pos))
    
44.             If dict(1).Exists(y) Then dict(1).Remove y
    
45.             For x = 2 To UBound(New_, 2)
    
46.               If Len(New_(y, x)) Then
    
47.                 If Not dict(2).Exists(New_(y, x)) Then
    
48.                   cnt = cnt + 1
    
49.                   rebuilt(rowSize, cnt) = New_(y, x)
    
50.                   dict(2).Add New_(y, x), ""
    
51.                 End If
    
52.               End If
    
53.             Next
    
54.           Next
    
55.         End If
    
56.       End If
    
57.     Next
    
58.     If cnt > colSize Then colSize = cnt
    
59.   Next
    
60.   Rows(rowSize).Resize(, colSize).Borders(9).LineStyle = xlDouble
    
61.   
    
62.   If dict(1).Count Then
    
63.     For i = 0 To dict(1).Count - 1
    
64.       cnt = 0
    
65.       rowSize = rowSize + 1
    
66.       y = dict(1).Keys()(i)
    
67.       dict(2).RemoveAll
    
68.       For x = 1 To UBound(New_, 2)
    
69.         If Len(New_(y, x)) Then
    
70.           If Not dict(2).Exists(New_(y, x)) Then
    
71.             cnt = cnt + 1
    
72.             rebuilt(rowSize, cnt) = New_(y, x)
    
73.             dict(2).Add New_(y, x), ""
    
74.           End If
    
75.         End If
    
76.       Next
    
77.       If cnt > colSize Then colSize = cnt
    
78.     Next
    
79.   End If
    
80.   
    
81.   Range("A1").Resize(rowSize, colSize) = rebuilt
    
82.   ActiveSheet.UsedRange.HorizontalAlignment = xlCenter
    
83.   
    
84.   For j = LBound(dict) To UBound(dict)
    
85.     Set dict(j) = Nothing
    
86.   Next
    
87.   
    
88.   Beep
    
89. End Sub

复制代码

baofa2

1. 重复，删除…………

复制代码

On_fire

baofa2 发表于 2024-3-30 21:04

老师早上好,
完美! 再次感谢….

On_fire

baofa2 发表于 2024-3-30 21:04

老师好,
请问您有没有时间再捋一下代码的思路?
1. New页的数据处理
New页, 每一行以A列为关键词,
先把A列有重复的关键词, 顺序上到下, 左到右, 合并不同的行在一起
( 注: 集合/排列到第一次出现所在行, 同时去重 )
模拟结果在New(2)页,
整理后的数据, 每一行的A列单元格是唯一值 ( = KEY )
( 注: 每行B列往右是相关连的资料, 也同时去重复, 取唯一值 )

2. Key页的数据处理
每一行的Key是独立的, 都是唯一值
( 注: 行与行之间没关系, 不串在一起, 也没任何关连 )

3. Rebuilt页的数据处理
根据了Key页每一行的Key的左到右的顺序,
取 New页对应唯一值的行, 顺序放在一起, 同时去重复
*
如果New页有Key的行,
但Key页没有的, 用双底线分开, 同时输出

###
老师好,
现在有一个问题, 如数据少, 代码的计算结果正常…
*
但如果数据多时, 会有串行的情况,
不同的关键词/唯一值的行, 会连在一起?