Private Sub Form_click()
Dim a As Variant,b(32) As Integer,c() As Integer,d() As String
Dim i As Long,j As Long
a = Array(2,5,6,12,14,28,4,6,12,30,31,32,2,8,13,28,29,30,1,2,5,16,20,26,1,7,8,12,16,21)
For i = 0 To 32
b(i) = i + 1
Next
ReDim c(UBound(b))
For i = 0 To UBound(b)
For j = 0 To UBound(a)
If b(i) = a(j) Then c(i) = c(i) + 1
Next
Next
ReDim Preserve d(x) As String
For i = 0 To UBound(c)
If c(i) > UBound(d) Then ReDim Preserve d(c(i)) As String
d(c(i)) = d(c(i)) & b(i) & " "
Next
Cls
For i = 0 To UBound(d)
Print d(i) & " 出现" & i & "次"
Next
End Sub
再问： 亲不好意思，没说清楚，第一组数的字数不固定（text1.text），但一定得是两两一组（带一空格），如05 06 07 ...........
再答： Private Sub Form_click() Dim a As Variant, b(32) As String, c() As Integer, d() As String Dim i As Long, j As Long Text1.Text = "02 05 06 12 14 28 04 06 12 30 31 32 02 08 13 28 29 30 01 02 05 16 20 26 01 07 08 12 16 21" a = Split(Text1.Text, " ") For i = 0 To 32 b(i) = Format(i + 1, "00") Next ReDim c(UBound(b)) For i = 0 To UBound(b) For j = 0 To UBound(a) If b(i) = a(j) Then c(i) = c(i) + 1 Next Next ReDim Preserve d(x) As String For i = 0 To UBound(c) If c(i) > UBound(d) Then ReDim Preserve d(c(i)) As String d(c(i)) = d(c(i)) & b(i) & " " Next Cls For i = 0 To UBound(d) Print d(i) & " 出现" & i & "次" Next End Sub
