[已解决]excel分类合并，高手帮忙下，谢谢。

loading_zzz

    A B列是数据   ，要得到C D列的结果，  b列字符长短不一，有数字有文字。   谢谢了！


新建 WinRAR 压缩文件管理器.rar (3.61 KB, 下载次数: 13)

2013-12-20 16:58 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

CheryBTL

2013-12-21 12:33

自下而上汇总，就可以省掉字典，再减化下：

1. Sub 汇总()
   
2.     Dim ar, re
   
3.     Dim i As Integer, str As String
   
4.     ar = Sheets(1).Range("A1:B" & Sheets(1).[a65536].End(3).Row)
   
5.     ReDim re(1 To UBound(ar), 1 To 2) As String
   
6.     For i = UBound(ar) To 1 Step -1
   
7.         If i = 1 Then
   
8.             re(i, 1) = ar(i, 1)
   
9.             re(i, 2) = ar(i, 2) & str
   
10.         Else
    
11.             If ar(i, 1) <> ar(i - 1, 1) Then
    
12.                 re(i, 1) = ar(i, 1)
    
13.                 re(i, 2) = ar(i, 2) & str
    
14.                 str = ""
    
15.             Else
    
16.                 str = ar(i, 2) & str
    
17.             End If
    
18.         End If
    
19.     Next i
    
20.     Sheets(1).[c1].Resize(UBound(re), 2) = re
    
21. End Sub

复制代码

跳转到最佳答案楼层

1091126096

先下载看看                        

CheryBTL

数字的汇总15位数字以内，还可以考虑用公式，一旦超过15位，函数公式就无能为力了，只能用VBA来完成。

CheryBTL

若即有文本又有纯数字，合并就用VBA吧，见附件：
VBA-汇总.rar (9.66 KB, 下载次数: 12)

2013-12-20 19:42 上传

点击文件名下载附件

loading_zzz

CheryBTL 发表于 2013-12-20 19:42
若即有文本又有纯数字，合并就用VBA吧，见附件：

大神，   太感谢你了。     你说我要看哪些书籍才能看懂那些代码呢？

CheryBTL

自下而上汇总，就可以省掉字典，再减化下：

1. Sub 汇总()
   
2.     Dim ar, re
   
3.     Dim i As Integer, str As String
   
4.     ar = Sheets(1).Range("A1:B" & Sheets(1).[a65536].End(3).Row)
   
5.     ReDim re(1 To UBound(ar), 1 To 2) As String
   
6.     For i = UBound(ar) To 1 Step -1
   
7.         If i = 1 Then
   
8.             re(i, 1) = ar(i, 1)
   
9.             re(i, 2) = ar(i, 2) & str
   
10.         Else
    
11.             If ar(i, 1) <> ar(i - 1, 1) Then
    
12.                 re(i, 1) = ar(i, 1)
    
13.                 re(i, 2) = ar(i, 2) & str
    
14.                 str = ""
    
15.             Else
    
16.                 str = ar(i, 2) & str
    
17.             End If
    
18.         End If
    
19.     Next i
    
20.     Sheets(1).[c1].Resize(UBound(re), 2) = re
    
21. End Sub

复制代码

CheryBTL

loading_zzz 发表于 2013-12-21 11:19
大神，   太感谢你了。     你说我要看哪些书籍才能看懂那些代码呢？

可以在站内搜索，VBA80集视频来学习