[已解决]帮忙修改代码，获取使用行数

楚雪飞扬

帮忙修改代码，获取使用行数从数据源（表一）A列（机台），算出对应机台的下机时间行数
目前问题，下机时间计算行数时，结果出错！
例：BETPJ-023 下机时间：29

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-10-29 14:16

楚雪飞扬 发表于 2021-10-29 13:39
感谢老师的帮忙，可能是我没有描述清楚，表二（机台RUN数）B列机台型号，需要从表一（数据源）铜抛机台自 ...

Sub demo()
   Set D = CreateObject("Scripting.Dictionary")
   a = Sheet1.UsedRange
   For I = 2 To UBound(a): D(a(I, 1)) = D(a(I, 1)) + 1: Next
   For I = 0 To D.Count - 1
      D(D.keys()(I)) = Array(I + 1, D.keys()(I), D.items()(I))
   Next
   Sheet2.UsedRange.Offset(1).ClearContents
   [a2].Resize(D.Count, 3) = Application.Rept(D.items, 1)
End Sub

跳转到最佳答案楼层

心正意诚身修

1. Sub 行数()
   
2. Dim ARR, BRR(), I As Integer, K As Integer, D, CRR, C
   
3. ARR = Sheets("数据源").Range("A1").CurrentRegion
   
4. I = UBound(ARR)
   
5. CRR = Range("B2:B" & Range("B2").End(xlDown).Row)
   
6. ReDim BRR(1 To UBound(CRR))
   
7. For K = 1 To UBound(CRR)
   
8. L = 1
   
9. For D = 2 To I
   
10.   If ARR(D, 1) = CRR(K, 1) Then
    
11.     BRR(K) = L
    
12.     L = L + 1
    
13.     End If
    
14.     Next
    
15. Next
    
16. Range("C2").Resize(UBound(CRR), 1) = Application.Transpose(BRR)
    
17. 
    
18. 
    
19. End Sub
    

复制代码

看下是不是这个意思

cutecpu

祝順心，南無阿彌陀佛！

楚雪飞扬

cutecpu 发表于 2021-10-29 11:31
祝順心，南無阿彌陀佛！

感谢老师的帮忙，可能是我没有描述清楚，表二（机台RUN数）B列机台型号，需要从表一（数据源）铜抛机台自动获取型号！

楚雪飞扬

心正意诚身修 发表于 2021-10-29 11:31
看下是不是这个意思

感谢老师的帮忙，可能是我没有描述清楚，表二（机台RUN数）B列机台型号，需要从表一（数据源）铜抛机台自动获取型号！

心正意诚身修

楚雪飞扬 发表于 2021-10-29 13:45
感谢老师的帮忙，可能是我没有描述清楚，表二（机台RUN数）B列机台型号，需要从表一（数据源）铜抛机台自 ...

1. Sub 行数()
   
2. Dim ARR, BRR(), I As Integer, K As Integer, D, C, DIC
   
3. Set D = CreateObject("SCRIPTING.DICTIONARY")
   
4. ARR = Sheets("数据源").Range("A2").CurrentRegion
   
5. ReDim BRR(1 To 1000, 1 To 3)
   
6. For K = 2 To UBound(ARR)
   
7. If Not D.EXISTS(ARR(K, 1)) Then
   
8. I = I + 1
   
9. D(ARR(K, 1)) = I
   
10.   BRR(I, 1) = I
    
11.   BRR(I, 2) = ARR(K, 1)
    
12.   BRR(I, 3) = 1
    
13.    Else
    
14.   BRR(D(ARR(K, 1)), 3) = BRR(D(ARR(K, 1)), 3) + 1
    
15. End If
    
16. Next
    
17. Range("A2").Resize(I, 3) = BRR
    
18. End Sub
    

复制代码

改了

cutecpu

楚雪飞扬 发表于 2021-10-29 13:39
感谢老师的帮忙，可能是我没有描述清楚，表二（机台RUN数）B列机台型号，需要从表一（数据源）铜抛机台自 ...

Sub demo()
   Set D = CreateObject("Scripting.Dictionary")
   a = Sheet1.UsedRange
   For I = 2 To UBound(a): D(a(I, 1)) = D(a(I, 1)) + 1: Next
   For I = 0 To D.Count - 1
      D(D.keys()(I)) = Array(I + 1, D.keys()(I), D.items()(I))
   Next
   Sheet2.UsedRange.Offset(1).ClearContents
   [a2].Resize(D.Count, 3) = Application.Rept(D.items, 1)
End Sub

心正意诚身修

在想你没有标题。如果加上标题。可能会错开一行。有标题就改成FOR K = 3 TO 把原来的2改成三