[已解决]求助

fghji

我想把 If cr(i) < 25 Then  运行的结果是按次数的最小到最大的顺序向下排
Sub test()   
    Dim ar, br, cr, dr(1 To 1000, 1 To 1)
    Dim i As Integer, j As Integer, k As Integer
    Dim s As String
    Dim d As Object
    Dim sh As Worksheet
    Set d = CreateObject("scripting.dictionary")
    For Each sh In Worksheets
        With sh
            ar = .Range("e15:is1121")
            For i = 1 To UBound(ar) Step 14
                For j = 1 To UBound(ar, 2)
                    If ar(i, j) <> "" Then
                        s = ""
                        For k = 1 To 3
                            s = s & Right(10 - Mid(ar(i, j), k, 1), 1)
                        Next
                        If Len(s) = 3 Then d(s) = d(s) + 1
                    End If
                Next
            Next
        End With
    Next
    br = d.Keys
    cr = d.Items
    j = 0
    For i = 0 To UBound(cr)
        If cr(i) < 25 Then
            j = j + 1
            dr(j, 1) = br(i)
        End If
    Next
    With Sheets(1)
    .Range("H1128").Resize(j, 1) = dr
    End With
End Sub

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-8-3 12:01

自己测试下吧

1. Sub test()
   
2.     Dim ar, br, cr, dr(1 To 1000, 1 To 1)
   
3.     Dim i As Integer, j As Integer, k As Integer, temp
   
4.     Dim s As String
   
5.     Dim d As Object
   
6.     Dim sh As Worksheet
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For Each sh In Worksheets
   
9.         With sh
   
10.             ar = .Range("e15:is1121")
    
11.             For i = 1 To UBound(ar) Step 14
    
12.                 For j = 1 To UBound(ar, 2)
    
13.                     If ar(i, j) <> "" Then
    
14.                         s = ""
    
15.                         For k = 1 To 3
    
16.                             s = s & Right(10 - Mid(ar(i, j), k, 1), 1)
    
17.                         Next
    
18.                         If Len(s) = 3 Then d(s) = d(s) + 1
    
19.                     End If
    
20.                 Next
    
21.             Next
    
22.         End With
    
23.     Next
    
24.     br = d.Keys
    
25.     cr = d.Items
    
26.     For i = 0 To UBound(cr) - 1 '排序
    
27.         For j = i + 1 To UBound(cr)
    
28.             If cr(i) > cr(j) Then
    
29.                 temp = cr(i)
    
30.                 cr(i) = cr(j)
    
31.                 cr(j) = temp
    
32.                 temp = br(i)
    
33.                 br(i) = br(j)
    
34.                 br(j) = temp
    
35.             End If
    
36.         Next
    
37.     Next
    
38.     j = 0
    
39.     For i = 0 To UBound(cr)
    
40.         If cr(i) < 25 Then
    
41.             j = j + 1
    
42.             dr(j, 1) = br(i)
    
43.         End If
    
44.     Next
    
45.     With Sheets(1)
    
46.         If j > 0 Then .Range("H1128").Resize(j, 1) = dr
    
47.     End With
    
48. End Sub

复制代码

跳转到最佳答案楼层

wayy

输出之后再排吧

hrpotter

自己测试下吧

1. Sub test()
   
2.     Dim ar, br, cr, dr(1 To 1000, 1 To 1)
   
3.     Dim i As Integer, j As Integer, k As Integer, temp
   
4.     Dim s As String
   
5.     Dim d As Object
   
6.     Dim sh As Worksheet
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For Each sh In Worksheets
   
9.         With sh
   
10.             ar = .Range("e15:is1121")
    
11.             For i = 1 To UBound(ar) Step 14
    
12.                 For j = 1 To UBound(ar, 2)
    
13.                     If ar(i, j) <> "" Then
    
14.                         s = ""
    
15.                         For k = 1 To 3
    
16.                             s = s & Right(10 - Mid(ar(i, j), k, 1), 1)
    
17.                         Next
    
18.                         If Len(s) = 3 Then d(s) = d(s) + 1
    
19.                     End If
    
20.                 Next
    
21.             Next
    
22.         End With
    
23.     Next
    
24.     br = d.Keys
    
25.     cr = d.Items
    
26.     For i = 0 To UBound(cr) - 1 '排序
    
27.         For j = i + 1 To UBound(cr)
    
28.             If cr(i) > cr(j) Then
    
29.                 temp = cr(i)
    
30.                 cr(i) = cr(j)
    
31.                 cr(j) = temp
    
32.                 temp = br(i)
    
33.                 br(i) = br(j)
    
34.                 br(j) = temp
    
35.             End If
    
36.         Next
    
37.     Next
    
38.     j = 0
    
39.     For i = 0 To UBound(cr)
    
40.         If cr(i) < 25 Then
    
41.             j = j + 1
    
42.             dr(j, 1) = br(i)
    
43.         End If
    
44.     Next
    
45.     With Sheets(1)
    
46.         If j > 0 Then .Range("H1128").Resize(j, 1) = dr
    
47.     End With
    
48. End Sub

复制代码