[已解决]求VBA

GYUHJ

book1.rar (12.95 KB, 下载次数: 7)

2013-7-12 13:44 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

上清宫主

2013-7-12 14:25

用了字典，请自行引用
Sub t()
Dim ar(), ar2(), ar3(), d As New Dictionary
ar = [j4:n47].Value
ar3 = Array(1, 4, 2, 2, 5)
ReDim ar2(1 To 3 * UBound(ar), 1 To 1)
For c% = 1 To UBound(ar, 2)
  For r% = 1 To UBound(ar)
      d(ar(r, c)) = d(ar(r, c)) + 1
      If ar(r + 1, c) = "" Then r = UBound(ar)
  Next
  For r = 0 To d.Count - 1
      If d.Items(r) > ar3(c - 1) Then
         i = i% + 1
         ar2(i, 1) = d.Keys(r)         
      End If
  Next
  d.RemoveAll
Next
[a1].Resize(i, 1) = ar2
End Sub

跳转到最佳答案楼层

上清宫主

用了字典，请自行引用
Sub t()
Dim ar(), ar2(), ar3(), d As New Dictionary
ar = [j4:n47].Value
ar3 = Array(1, 4, 2, 2, 5)
ReDim ar2(1 To 3 * UBound(ar), 1 To 1)
For c% = 1 To UBound(ar, 2)
  For r% = 1 To UBound(ar)
      d(ar(r, c)) = d(ar(r, c)) + 1
      If ar(r + 1, c) = "" Then r = UBound(ar)
  Next
  For r = 0 To d.Count - 1
      If d.Items(r) > ar3(c - 1) Then
         i = i% + 1
         ar2(i, 1) = d.Keys(r)         
      End If
  Next
  d.RemoveAll
Next
[a1].Resize(i, 1) = ar2
End Sub