数据合并问题

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.21
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, 2).End(3).Row
   
6.         c = .Cells(1, "XFD").End(1).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.     End With
   
9.     ReDim brr(1 To 10000, 1 To 100)
   
10.     For i = 2 To UBound(arr)
    
11.         s = arr(i, 2)
    
12.         If Not d.exists(s) Then
    
13.             m = m + 1
    
14.             d(s) = m
    
15.             For j = 1 To UBound(arr, 2)
    
16.                 brr(m, j) = arr(i, j)
    
17.             Next
    
18.         Else
    
19.             r = d(s)
    
20.             For j = 4 To UBound(arr, 2)
    
21.                 brr(r, j) = brr(r, j) + arr(i, j)
    
22.             Next
    
23.         End If
    
24.     Next
    
25.     With Sheets("Sheet2")
    
26.         .UsedRange.Offset(1).ClearContents
    
27.         .[a2].Resize(m, UBound(arr, 2)) = brr
    
28.     End With
    
29.     Set d = Nothing
    
30.     Application.ScreenUpdating = False
    
31.     MsgBox "OK！"
    
32. End Sub
    

复制代码

scnc001

ykcbf1100 发表于 2024-12-21 20:57
附件供参考。。。

似乎有点问题。。。我从上面复制了两行到下面，然后把列的数据修改了一下，好像没有正确填写到上面的行里去

scnc001

usedrange 发表于 2024-12-21 09:30
猜一个，不知道是不是这样

感谢帮助，能发可以复制的代码吗

scnc001

翁知江安 发表于 2024-12-21 10:55
Sub hz()
Dim i, j, k, irow, irow1 As Integer
Dim ar, br As Variant

感谢帮助。"粘贴部分"是指？未被合并的内容在同一工作表最下方。想手动修改下方未被合并内容的A/B列跟上面的一致，然后再次合并一下，合并到上面去。是同一工作表。

ykcbf1100

scnc001 发表于 2024-12-21 23:49
似乎有点问题。。。我从上面复制了两行到下面，然后把列的数据修改了一下，好像没有正确填写到上面的行里 ...

源数据是表1,你不要在表2增加数据。
如果你想在原表上做也可以，但那样就只能做一次，无法重复操作。

scnc001

ykcbf1100 发表于 2024-12-22 07:48
源数据是表1,你不要在表2增加数据。
如果你想在原表上做也可以，但那样就只能做一次，无法重复操作。

万分感谢，现在好了。对于现在使用的场景来说，这个相当于是调改后的中间数据，没必要保留，也不影响原始数据，所以在表内操作一次就够了。如果有新的项目，原始数据是新的，个别需要调改的数据也不一样，所以不影响使用。

ykcbf1100

scnc001 发表于 2024-12-22 08:15
万分感谢，现在好了。对于现在使用的场景来说，这个相当于是调改后的中间数据，没必要保留，也不影响原始 ...

再改一下吧，原表执行