[已解决]帮忙修改下代码？

dsfada

能不能修改下原代码，执行程序后达到表2的效果，到I列最后一行结束

最佳答案

月排行榜 / 总排行榜

grf1973

2016-1-21 16:13

1. Sub text()
   
2.     s = "shuju"
   
3.     With Range("c10:s" & Range("i65536").End(3).Row)
   
4.         arr = .Value
   
5.         r = UBound(arr)
   
6.         For i = 1 To r Step 2
   
7.             m = m + 1
   
8.             n = 0
   
9.             For k = i To i + 1
   
10.                 If k > r Then Exit For
    
11.                 n = n + 1
    
12.                 arr(k, 6) = s & m & n
    
13.             Next
    
14.         Next
    
15.         For i = 2 To r
    
16.             arr(i, 1) = arr(i - 1, 1) + 1
    
17.             For j = 2 To UBound(arr, 2)
    
18.                 If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
    
19.             Next
    
20.         Next
    
21.         .Value = arr
    
22.     End With
    
23. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub text()
   
2.     s = "shuju"
   
3.     With Range("c10:s" & Range("i65536").End(3).Row)
   
4.         arr = .Value
   
5.         r = UBound(arr)
   
6.         For i = 1 To r Step 2
   
7.             m = m + 1
   
8.             n = 0
   
9.             For k = i To i + 1
   
10.                 If k > r Then Exit For
    
11.                 n = n + 1
    
12.                 arr(k, 6) = s & m & n
    
13.             Next
    
14.         Next
    
15.         For i = 2 To r
    
16.             arr(i, 1) = arr(i - 1, 1) + 1
    
17.             For j = 2 To UBound(arr, 2)
    
18.                 If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
    
19.             Next
    
20.         Next
    
21.         .Value = arr
    
22.     End With
    
23. End Sub

复制代码

grf1973

代码可以简化一点，原来H列的那个算法太复杂了。

1. Sub text()
   
2.     s = "shuju"
   
3.     On Error Resume Next
   
4.     With Range("c10:s" & Range("i65536").End(3).Row)
   
5.         arr = .Value
   
6.         r = UBound(arr)
   
7.         For i = 1 To r
   
8.             m = Int((i + 1) / 2)
   
9.             n = (i - 1) Mod 2 + 1
   
10.             arr(i, 6) = s & m & n
    
11.             arr(i, 1) = arr(i - 1, 1) + 1
    
12.             For j = 2 To UBound(arr, 2)
    
13.                 If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
    
14.             Next
    
15.         Next
    
16.         .Value = arr
    
17.     End With
    
18. End Sub

复制代码

votoldq2002

见附件！

dsfada

Sub text()
    s = "shuju"
    With Range("c10:s" & Range("i65536").End(3).Row)
        arr = .Value
        r = UBound(arr)
        For i = 1 To r Step 2
            m = m + 1
            n = 0
            For k = i To i + 1
                If k > r Then Exit For
                    arr(k, 1) = k
                For l = 2 To 17 Step 1
                    arr(k, l) = arr(1, l)
                Next
                n = n + 1
                arr(k, 6) = s & m & n
            Next
        Next
        .Value = arr
    End With
End Sub

dsfada

grf1973 发表于 2016-1-21 16:24
代码可以简化一点，原来H列的那个算法太复杂了。

想把H列那段代码去掉，其他列数据还是向下复制，序列号向下递增，代码怎么修改？

dsfada

grf1973 发表于 2016-1-21 16:24
代码可以简化一点，原来H列的那个算法太复杂了。

按3楼的方法代码怎么修改？

grf1973

Sub text()
    s = "shuju"
    On Error Resume Next
    arr = Range("c10:s" & Range("i65536").End(3).Row)
    For i = 1 To UBound(arr)
        m = (i - 1) \ 3 + 1
        n = (i - 1) Mod 3 + 1
        arr(i, 6) = s & m & n
        arr(i, 1) = arr(i - 1, 1) + 1
        For j = 2 To UBound(arr, 2)
            If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
        Next
    Next
    Range("c10:s" & Range("i65536").End(3).Row) = arr
End Sub

dsfada

grf1973 发表于 2016-1-22 16:11
Sub text()
    s = "shuju"
    On Error Resume Next

请问这道斜线是什么意思，好像不是除号？

grf1973

整除