求助：如我在sheet1流水输入张三、李四等相关数据，那么在sheet2中怎么实现分类

dgsksk

：如我在sheet1流水输入张三、李四等相关数据，那么在sheet2中分类出现张三李四及相关数据

sheet1

sheet2

新建 Microsoft Excel 工作表.zip (2.3 KB, 下载次数: 4)

2014-2-5 12:25 上传

点击文件名下载附件
如图文件

图中王五是自己用手工输入的，要的是这样的结果

CheryBTL

函数有点困难，用VBA倒是很容易，等下补上代码。

CheryBTL

1. Sub test()
   
2.     Dim ar, re, temp
   
3.     Dim i As Integer, j As Integer, Cnt As Integer, R As Integer
   
4.     Dim d As Object
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ar = Sheets(1).Range("A2").CurrentRegion
   
7.     ReDim temp(1 To UBound(ar))
   
8.     ReDim re(1 To UBound(ar) * 11, 1 To 3)
   
9.     For i = 2 To UBound(ar)
   
10.         If Not d.exists(ar(i, 2)) Then
    
11.             Cnt = Cnt + 1
    
12.             d(ar(i, 2)) = Cnt
    
13.             temp(Cnt) = 2
    
14.             re(Cnt * 11 - 10, 1) = "日期"
    
15.             re(Cnt * 11 - 9, 1) = ar(i, 1)
    
16.             re(Cnt * 11 - 10, 2) = "姓名"
    
17.             re(Cnt * 11 - 9, 2) = ar(i, 2)
    
18.             re(Cnt * 11 - 10, 3) = "金额"
    
19.             re(Cnt * 11 - 9, 3) = ar(i, 3)
    
20.         Else
    
21.             R = d(ar(i, 2))
    
22.             temp(R) = temp(R) + 1
    
23.             re(R * 11 - 11 + temp(R), 1) = ar(i, 1)
    
24.             re(R * 11 - 11 + temp(R), 2) = ar(i, 2)
    
25.             re(R * 11 - 11 + temp(R), 3) = ar(i, 3)
    
26.         End If
    
27.     Next
    
28.     Sheets(2).[a1:C65536].ClearContents
    
29.     Sheets(2).[a2].Resize(UBound(re), 3) = re
    
30. End Sub

复制代码

见附件：
新建 Microsoft Excel 工作表.rar (10.24 KB, 下载次数: 20)

2014-2-5 13:03 上传

点击文件名下载附件

CheryBTL

代码可以简化，但速度上稍逊一点点：

1. Sub test()
   
2.     Dim ar, re, temp
   
3.     Dim i As Integer, j As Integer, Cnt As Integer, R As Integer
   
4.     Dim d As Object
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ar = Sheets(1).Range("A2").CurrentRegion
   
7.     ReDim temp(1 To UBound(ar))
   
8.     ReDim re(1 To UBound(ar) * 11, 1 To 3)
   
9.     For i = 2 To UBound(ar)
   
10.         If Not d.exists(ar(i, 2)) Then
    
11.             Cnt = Cnt + 1
    
12.             d(ar(i, 2)) = Cnt
    
13.             temp(Cnt) = 1
    
14.             re(Cnt * 11 - 10, 1) = "日期"
    
15.             re(Cnt * 11 - 10, 2) = "姓名"
    
16.             re(Cnt * 11 - 10, 3) = "金额"
    
17.         End If
    
18.             R = d(ar(i, 2))
    
19.             temp(R) = temp(R) + 1
    
20.             re(R * 11 - 11 + temp(R), 1) = ar(i, 1)
    
21.             re(R * 11 - 11 + temp(R), 2) = ar(i, 2)
    
22.             re(R * 11 - 11 + temp(R), 3) = ar(i, 3)
    
23.     Next
    
24.     Sheets(2).[a1:C65536].ClearContents
    
25.     Sheets(2).[a2].Resize(UBound(re), 3) = re
    
26. End Sub

复制代码

dgsksk

CheryBTL 发表于 2014-2-5 13:05
代码可以简化，但速度上稍逊一点点：

不能用函数有点麻烦哦！！！看来只能换思路了。因为我对ＶＢＡ不懂哦

不过还是谢谢大大的解答

CheryBTL

dgsksk 发表于 2014-2-5 13:49
不能用函数有点麻烦哦！！！看来只能换思路了。因为我对ＶＢＡ不懂哦

不过还是谢谢大大的解答

函数的话，也可以，但是不通用。

如上面的代码不是直接就可以用了么？
若与实际有差异，可以把实际数据和想要放置的位置明确，代码稍改即可使用。

dgsksk

我已经下载你的代码了！可以用了！要用ＶＢＡ的话看来还是要好好肯肯书了，理解了你写的东西才好修改、谢谢了！