[已解决]求在A列列出：按C列给的次数B列给出的名单【见图与附件】

gavincar

求在A列列出：按C列给的次数B列给出的名单【见图与附件】
非常感谢！

附.zip (6.39 KB, 下载次数: 11)

2015-4-4 09:41 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

lisachen

2015-4-4 09:59

附.rar (10.85 KB, 下载次数: 19)

2015-4-4 09:58 上传

点击文件名下载附件

跳转到最佳答案楼层

心正意诚身修

用函數湊熱鬧

lisachen

附.rar (10.85 KB, 下载次数: 19)

2015-4-4 09:58 上传

点击文件名下载附件

qh8600

1. Sub demo()
   
2.     Dim ar, br(1 To 100000, 1 To 1), i As Long, x As Long
   
3.     ar = Range("b2:c" & Cells(Rows.Count, 2).End(3).Row)
   
4.     For i = 1 To UBound(ar)
   
5.         For x = 1 To ar(i, 2)
   
6.             n = n + 1
   
7.             br(n, 1) = ar(i, 1)
   
8.         Next
   
9.     Next
   
10.     Range("a2").Resize(n, 1) = br
    
11. End Sub

复制代码

楼主试试，附件楼下

dsmch

1. Sub Macro1()
   
2. Dim arr, i&, n&
   
3. arr = Range("b1:c" & Range("b65536").End(xlUp).Row)
   
4. [a2:a60000] = ""
   
5. For i = 2 To UBound(arr)
   
6.     n = Range("a65536").End(xlUp).Row + 1
   
7.     Cells(n, 1).Resize(arr(i, 2)) = arr(i, 1)
   
8. Next
   
9. End Sub

复制代码

雪舞子

1. Sub test()
   
2.     Dim arr, brr(), i%, j%, n&, m&
   
3.     arr = Range("b1:c" & [c65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         If Not IsNumeric(arr(i, 2)) Then Exit For
   
6.         n = n + arr(i, 2)
   
7.         ReDim Preserve brr(n + 1)
   
8.         For j = 1 To arr(i, 2)
   
9.             m = m + 1
   
10.             brr(m) = arr(i, 1)
    
11.         Next
    
12.     Next
    
13.     brr(0) = "姓名"
    
14.     [g1:g9999] = ""
    
15.     [G1].Resize(n + 1) = Application.Transpose(brr)
    
16. End Sub

复制代码

附.rar (11.45 KB, 下载次数: 3)

2015-4-4 10:09 上传

点击文件名下载附件

gavincar

非常感谢各位的热心回复，太感谢了。
不过只能选一个最佳答案，这个是最头疼的，我认真看一下再做决定，非常感谢！

江河行地

=LOOKUP(ROW(A1),SUMIF(OFFSET(C$1,,,ROW($1:$3)),"<>")+1,B$2:B$4)