Question

VB二维数组中找出相同值并统计个数

Const k = 101 'excel表中要统计的记录，比如从A1～A69，你要根据你情况修改此值
Dim content(k), counts(k) '定义两个数组，分别存放公司名称和出现次数，一一对应
i = 1: j = 1: m = 1: lie = 0
Do While i <= k
n = 1
For lie = lie + 1 To k + 1
For j = i + 1 To k + 1

If (Cells(j, lie) = Cells(i, lie)) Then '读入并比较两临近单元格值，若相等，计数器+1
n = n + 1
Else '若不等，则将值分别存放在两个数组中，并跳出循环
m = m + 1
content(m) = Cells(i, lie)
counts(m) = n
GoTo s1
End If

Next j
s1:
i = j
'此时交换数值，VBA怎么不支持swap i, j ？
Loop
'
Cells(k + 2, 1) = "统计结果："
For l = 1 To m '输出结果
Cells(k + l + 2, 1) = content(l)
Cells(k + l + 2, 2) = counts(l)
Next

'
End Sub
这是我编的程，有错，请高手修改

Answer 1

Const k = 13
Dim counts(), content()
Sub aa()
n = 0
ReDim Preserve content(1)
content(1) = Cells(1, 1)
For i = 1 To k

For j = 1 To UBound(content)
If Cells(i, 1) = content(j) Then
m = m + 1
End If
Next j

If m = 0 Then
n = UBound(content) + 1
ReDim Preserve content(n)
content(n) = Cells(i, 1)
End If

m = 0
Next i

For z = 1 To UBound(content)
Cells(z + k + 2, 1) = content(z)
Next z

t = 0

For j = 1 To UBound(content)

For i = 1 To k
If content(j) = Cells(i, 1) Then
t = t + 1
End If
Next i

l = l + 1
Cells(l + k + 2, 2) = t
t = 0
Next j
End Sub

这个计算单列数据的。