[已解决]新增第四步判断条件。

爷们679

宏名 t  是由idnoidno网友支持和提供本工作薄的代码
宏名 liz 是我仿照idnoidno网友写的。我想新增第四步，不知道要什么写。

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-9-13 11:16

1. Sub aaa()
   
2. Dim arr, brr, i&, n&
   
3. arr = Range("i4:i" & [i65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr) + 2, 1 To 7)
   
5. For i = 1 To UBound(arr)
   
6.   brr(i, 1) = Int(arr(i, 1) / 10)
   
7.   brr(i, 2) = arr(i, 1) Mod 10
   
8.   If i > 2 Then
   
9.     brr(i, 3) = brr(i - 2, 2) + brr(i - 1, 2)
   
10.     n = brr(i, 3)
    
11.     If n > 16 Then n = n - 16
    
12.     If n < 7 Or n > 10 Then
    
13.       brr(i, 5) = n Mod 10
    
14.       brr(i, 7) = brr(i, 5) + 10
    
15.     Else
    
16.       brr(i, 5) = n
    
17.     End If
    
18.   End If
    
19. Next i
    
20. [k4].Resize(UBound(brr), 7) = brr
    
21. End Sub

复制代码

跳转到最佳答案楼层

idnoidno

1. Sub liz()
   
2. Dim ar, i%, j%
   
3. ar = Worksheets("sheet3").Range("i4").CurrentRegion
   
4. For i = 2 To UBound(ar)
   
5.     If ar(i, 1) < 10 Then
   
6.         Cells(i + 2, 11) = 0: Cells(i + 2, 12) = ar(i, 1)
   
7.     Else
   
8.         Cells(i + 2, 11) = Mid(ar(i, 1), 1, 1): Cells(i + 2, 12) = Mid(ar(i, 1), 2, 1)
   
9.     End If
   
10.    
    
11.     Cells(i + 4, 13) = Cells(i + 3, 12) + Cells(i + 2, 12)
    
12.         
    
13.         If Cells(i + 4, 13) < 7 Then
    
14.             Cells(i + 4, 16) = Cells(i + 4, 13)
    
15.             Cells(i + 4, 18) = Cells(i + 4, 13) + 10
    
16.         ElseIf Cells(i + 4, 13) < 11 Then
    
17.             Cells(i + 4, 16) = Cells(i + 4, 13)
    
18.             Cells(i + 4, 18) = ""
    
19.         ElseIf Cells(i + 4, 13) < 17 Then
    
20.             Cells(i + 4, 16) = Cells(i + 4, 13) - 10
    
21.             Cells(i + 4, 18) = Cells(i + 4, 13)
    
22.         Else
    
23.             If Cells(i + 4, 13) - 16 < 7 Then
    
24.                 Cells(i + 4, 16) = Cells(i + 4, 13) - 16
    
25.                 Cells(i + 4, 18) = Cells(i + 4, 13) - 16 + 10
    
26.             ElseIf Cells(i + 4, 13) - 16 < 11 Then
    
27.                 Cells(i + 4, 16) = Cells(i + 4, 13) - 16
    
28.                 Cells(i + 4, 18) = ""
    
29.             Else
    
30.                 Cells(i + 4, 16) = Cells(i + 4, 13) - 16 - 10
    
31.                 Cells(i + 4, 18) = Cells(i + 4, 13) - 16
    
32.             End If
    
33.         End If
    
34. Next i
    
35. End Sub

复制代码

idnoidno

大哥，亂了。昏了。頭大了

grf1973

供参考。。。。。。。
Sub liz()
    Dim ar, i%, j%
    ar = Worksheets("sheet3").Range("i4").CurrentRegion
    For i = 2 To UBound(ar)
        If ar(i, 1) < 10 Then
            Cells(i + 2, 11) = 0: Cells(i + 2, 12) = ar(i, 1)
        Else
            Cells(i + 2, 11) = Mid(ar(i, 1), 1, 1): Cells(i + 2, 12) = Mid(ar(i, 1), 2, 1)
        End If
        Cells(i + 4, 13) = Cells(i + 3, 12) + Cells(i + 2, 12)
        
        r = i + 4: x = Cells(r, "M")
        If x > 16 Then x = x - 16
        Cells(r, "O") = IIf(x < 10, x, x - 10)
        Cells(r, "Q") = IIf(x < 7, x + 10, IIf(x > 10, x, ""))
    Next i
End Sub

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, n&
   
3. arr = Range("i4:i" & [i65536].End(3).Row)
   
4. ReDim brr(1 To UBound(arr) + 2, 1 To 7)
   
5. For i = 1 To UBound(arr)
   
6.   brr(i, 1) = Int(arr(i, 1) / 10)
   
7.   brr(i, 2) = arr(i, 1) Mod 10
   
8.   If i > 2 Then
   
9.     brr(i, 3) = brr(i - 2, 2) + brr(i - 1, 2)
   
10.     n = brr(i, 3)
    
11.     If n > 16 Then n = n - 16
    
12.     If n < 7 Or n > 10 Then
    
13.       brr(i, 5) = n Mod 10
    
14.       brr(i, 7) = brr(i, 5) + 10
    
15.     Else
    
16.       brr(i, 5) = n
    
17.     End If
    
18.   End If
    
19. Next i
    
20. [k4].Resize(UBound(brr), 7) = brr
    
21. End Sub

复制代码

idnoidno

學習高手的解決思路

爷们679

idnoidno 发表于 2017-9-13 17:39
學習高手的解決思路

对，我发现大家写代码都离不开函数。看看大家，再仿照。每天进步一点点。