统计同一批次钢瓶个数

cysczhumh

总是下标有问题，没看出来。请教高手。

饮冰e士

limonet

，这是个二维数组。
换成：brr(i) = brr(i) = Left(arr(i, 1), Len(arr(i, 1)) - 3)
段首加一行On Error Resume Next

ykcbf1100

brr应该用二维数组，你却定义成一维数据。
你直接用B列数组统计就行了，干么一定要用A列数组呢？

ykcbf1100

新写一个吧。

A列数据并不规范的，有的可能少于3位。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.2
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 1)
   
5.     ReDim brr(1 To r, 1 To 2)
   
6.     On Error Resume Next
   
7.     For i = 2 To UBound(arr)
   
8.         If Len(arr(i, 1)) > 3 Then
   
9.             s = Left(CStr(arr(i, 1)), Len(CStr(arr(i, 1))) - 3)
   
10.             If Not d.exists(s) Then
    
11.                 m = m + 1
    
12.                 d(s) = m
    
13.                 brr(m, 1) = s
    
14.                 brr(m, 2) = 1
    
15.             Else
    
16.                 brr(d(s), 2) = brr(d(s), 2) + 1
    
17.             End If
    
18.         End If
    
19.     Next
    
20.     [f2].Resize(m, 2) = brr
    
21. End Sub
    
22. 
    

复制代码

cysczhumh

ykcbf1100 发表于 2024-9-2 13:08
brr应该用二维数组，你却定义成一维数据。
你直接用B列数组统计就行了，干么一定要用A列数组呢？

原来是想由A列直接统计出个数，先由A列得到B列，再由B列统计葛叔叔，最后B列去重，得到结果。没办法了搞出了B列作为辅助列。字典和数组结合，很高深啊！值得领会一阵子了，谢谢了！！！

cysczhumh

limonet 发表于 2024-9-2 12:58
，这是个二维数组。
换成：brr(i) = brr(i) = Left(arr(i, 1), Len(arr(i, 1)) - 3)
段首加一行On Error  ...

On Error Resume Next这个语句很关键，有了它程序就继续运行下去了，但brr(i) = brr(i) = Left(arr(i, 1), Len(arr(i, 1)) - 3)这种等式，第一次见到。谢谢！

ykcbf1100

cysczhumh 发表于 2024-9-2 14:14
原来是想由A列直接统计出个数，先由A列得到B列，再由B列统计葛叔叔，最后B列去重，得到结果。没办法了搞 ...

字典+数组是处理数据时最常用的，建议你多学学。

cysczhumh

limonet 发表于 2024-9-2 12:58
，这是个二维数组。
换成：brr(i) = brr(i) = Left(arr(i, 1), Len(arr(i, 1)) - 3)
段首加一行On Error  ...

Sub bb()
Application.ScreenUpdating = False
On Error Resume Next
t = Timer
Dim arr, brr, n, k
n = Sheet1.Range("A65535").End(xlUp).Row
arr = Sheet1.Range(("a1:a") & n)
ReDim brr(2 To n, 1 To 2)
For i = 1 To n '数组赋值
   'brr(i) = brr(i) = Left(arr(i, 1), Len(arr(i, 1)) - 3)
    brr(i, 1) = Left(arr(i, 1), Len(arr(i, 1)) - 3) '去掉最后3位的值
Next i

Sheet1.[b2].Resize(n, 1) = brr '生产批号赋值

For i = 2 To n '统计相同批号的钢瓶个数
  If brr(i, 1) = brr(i + 1) Then
    k = k + 1
  Else
    Cells(i, 3) = k
    k = 1
  End If
  
Next i
MsgBox "用时" & Format((Timer - t), "#0.00") & "秒"
Application.ScreenUpdating = True
End Sub

这样只能运行到生产批号赋值