[已解决]不用format函数不用instr函数，只用VBA数组方法改写这个遗漏计算

laoau138

不用format函数不用instr函数，只用VBA数组方法改写这个遗漏计算


Sub test()
Dim SArr1(), SArr2, Tarr(), i%, j%, n%
SArr2 = [k10:aq10]
n = [c11].End(xlDown).Row
ReDim SArr1(11 To n)
ReDim Tarr(11 To n, 1 To 33)
For i = 11 To n
  For j = 3 To 8
    SArr1(i) = SArr1(i) & "," & Format(Cells(i, j), "00")
  Next
Next
For i = 11 To n
  For j = 1 To 33
    If i = 11 Then
       Tarr(i, j) = IIf(InStr(1, SArr1(i), "," & Format(SArr2(1, j), "00")) > 0, 0, 1)
    Else
       Tarr(i, j) = IIf(InStr(1, SArr1(i), "," & Format(SArr2(1, j), "00")) > 0, 0, 1 + Tarr(i - 1, j))
    End If
  Next
Next
[k11].Resize(n - 10, 33) = Tarr
End Sub

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-7-19 11:52

1. Sub aaa()
   
2. Dim arr, brr, i&, j&
   
3. arr = Range("c11:h" & [c65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 33)
   
5. For i = 1 To UBound(arr)
   
6.   For j = 1 To UBound(arr, 2)
   
7.     brr(i, arr(i, j)) = 0
   
8.   Next j
   
9. Next i
   
10. For i = 1 To UBound(brr)
    
11.   For j = 1 To 33
    
12.     If brr(i, j) = "" Then If i = 1 Then brr(i, j) = 1 Else brr(i, j) = brr(i - 1, j) + 1
    
13.   Next j
    
14. Next i
    
15. [k11].Resize(UBound(brr), 33) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&
   
3. arr = Range("c11:h" & [c65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 33)
   
5. For i = 1 To UBound(arr)
   
6.   For j = 1 To UBound(arr, 2)
   
7.     brr(i, arr(i, j)) = 0
   
8.   Next j
   
9. Next i
   
10. For i = 1 To UBound(brr)
    
11.   For j = 1 To 33
    
12.     If brr(i, j) = "" Then If i = 1 Then brr(i, j) = 1 Else brr(i, j) = brr(i - 1, j) + 1
    
13.   Next j
    
14. Next i
    
15. [k11].Resize(UBound(brr), 33) = brr
    
16. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-7-19 11:52

果然是高手

idnoidno

发表于 2017-7-19 11:40 貼帖
发表于 2017-7-19 11:52 答覆

12分鐘時間改好，我到現在還看不是很懂大哥您的題目意思，真是嘔血了，技術不如人，連看文字也不如人
磕頭了

laoau138

idnoidno 发表于 2017-7-19 16:13
发表于 2017-7-19 11:40 貼帖
发表于 2017-7-19 11:52 答覆

不懂多少分钟有什么关系