楼主
xmyjk |
Q:如何运用VBA统计遗漏数据?
A:- Option Explicit
- Sub t()
- Dim d() As Dictionary, arr, brr, i&, j&, crr(), jg, m() As Long, k&
- Columns("h:k").Clear
- arr = [a1].CurrentRegion.Value
- ReDim d(1 To UBound(arr, 2)) As Dictionary
- ReDim crr(1 To UBound(arr, 2))
- ReDim jg(1 To UBound(arr), 1 To 5)
- ReDim m(1 To UBound(arr, 2))
- For i = 1 To UBound(arr, 2)
- Set d(i) = New Dictionary
- crr(i) = jg
- Next
- For i = 1 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- If Len(Trim(arr(i, j))) <> 0 Then
- If Not (d(j).exists(arr(i, j))) Then
- m(j) = m(j) + 1
- d(j)(arr(i, j)) = m(j)
- crr(j)(m(j), 1) = 0
- crr(j)(m(j), 2) = 0
- crr(j)(m(j), 3) = "ͳ¼Æ" & Chr(64 + j) & "ÁÐ"
- crr(j)(m(j), 4) = i
- crr(j)(m(j), 5) = 0
- Else
- crr(j)(d(j)(arr(i, j)), 5) = i - crr(j)(d(j)(arr(i, j)), 4) - 1
- crr(j)(d(j)(arr(i, j)), 1) = Application.Max(crr(j)(d(j)(arr(i, j)), 5), crr(j)(d(j)(arr(i, j)), 1))
- crr(j)(d(j)(arr(i, j)), 4) = i
- End If
- For k = 1 To m(j)
- crr(j)(k, 2) = i - crr(j)(k, 4)
- Next
- End If
- Next
- Next
- For i = 1 To UBound(m)
- With [h65536].End(3)
- .Offset(1, 1).Resize(m(i), 3) = crr(i)
- .Offset(1).Resize(m(i), 1) = Application.Transpose(d(i).Keys)
- End With
- Next
- End Sub
 统计遗漏.rar
|
