请问如何写1到20，再从20到1，如此循环的代码啊？

65861954

请问如何写1到20，再从20到1，如此循环的代码啊？谢谢各位大神了。
Sub tttt()
Dim irow, j, k As Integer
k = 1
irow = Range("a65536").End(xlUp).Row
        For j = 2 To irow
            Range("h" & j) = k
            If k = 1 Then
            a = 1
            ElseIf k = 20 Then
            a = -1
            End If
            k = k + a
    Next
End Sub

ww87725244

只是一次1-20，再20-1？

65861954

ww87725244 发表于 2020-11-13 22:49
只是一次1-20，再20-1？

很多次。写一次直接在表格里完成最快

ww87725244

那不是死循环了？

65861954

ww87725244 发表于 2020-11-13 22:58
那不是死循环了？

写到我a列单元格为空就退出循环

yjh_27

Sub tttt()
Dim irow, j, k As Integer
k = 1
a = 1
irow = Range("a65536").End(xlUp).Row
        For j = 2 To irow
            Range("h" & j) = k
            k = k + a
            If k = 1  or k = 20 Then a = -a
        Next
End Sub

65861954

Sub tttt()
Dim irow, j, k As Integer
k = 1
irow = Range("a65536").End(xlUp).Row
        For j = 2 To irow
            Range("h" & j) = k
            If k = 1 And Range("h" & j - 1) = 1 Then
            a = 1
            ElseIf k = 1 And Range("h" & j - 1) <> 1 Then
            a = 0
            ElseIf k = 20 And Range("h" & j - 1) = 20 Then
            a = -1
            ElseIf k = 20 And Range("h" & j - 1) <> 20 Then
            a = 0
            End If
            k = k + a
    Next
End Sub
谢谢大家，我自己写出来了

65861954

Sub tttt() Dim irow, j, k As Integer k = 1  irow = Range("a65536").End(xlUp).Row         For j = 2 To irow             Range("h" & j) = k             If k = 1 And Range("h" & j - 1) = 1 Then             a = 1             ElseIf k = 1 And Range("h" & j - 1) <> 1 Then             a = 0             ElseIf k = 20 And Range("h" & j - 1) = 20 Then             a = -1             ElseIf k = 20 And Range("h" & j - 1) <> 20 Then             a = 0             End If             k = k + a     Next End Sub

65861954

谢谢大家，问题已经解决。
Sub tttt()
Dim irow, j, k As Integer
k = 1
irow = Range("a65536").End(xlUp).Row
        For j = 2 To irow
            Range("h" & j) = k
            If k = 1 And Range("h" & j - 1) = 1 Then
            a = 1
            ElseIf k = 1 And Range("h" & j - 1) <> 1 Then
            a = 0
            ElseIf k = 20 And Range("h" & j - 1) = 20 Then
            a = -1
            ElseIf k = 20 And Range("h" & j - 1) <> 20 Then
            a = 0
            End If
            k = k + a
    Next
End Sub

Moneky

1. Sub tttt()
   
2.     't = Timer
   
3.     Dim irow, j, k As Integer '只有k被定义成了integer，前面几个都是Variant
   
4.     k = 1
   
5.     irow = Range("a65536").End(xlUp).Row
   
6.     For j = 2 To irow
   
7.         Range("h" & j) = k '直接操作range对象数量大时速度会慢的比较明显
   
8.         If k = 1 Then '这个if结构可以优化一下
   
9.         a = 1
   
10.         ElseIf k = 20 Then
    
11.         a = -1
    
12.         End If
    
13.         k = k + a
    
14.     Next
    
15.     't = Timer - t
    
16.     'Debug.Print t
    
17. End Sub
    
18. Sub test()
    
19.     't = Timer
    
20.     Dim irow As Long, j As Long, k As Long, a As Long
    
21.     Dim hrr() As Long
    
22.     k = 1
    
23.     a = -1
    
24.     irow = Range("a65536").End(xlUp).Row
    
25.     ReDim hrr(irow - 2, 0) '采用数组提速，这里下标是从0开始的
    
26.     For j = 0 To irow - 2
    
27.         hrr(j, 0) = k
    
28.         If k = 1 Or k = 20 Then a = -a
    
29.         k = k + a
    
30.     Next
    
31.     Range("h2").Resize(irow - 1, 1) = hrr
    
32.     't = Timer - t
    
33.     'Debug.Print t
    
34. End Sub

复制代码

用数组写了一遍，思路是一样的，不过速度提上很明显，如果a列最后一行是10001行，我的电脑上运行时间如下：
sub tttt时间： 0.4400024
sub test时间：1.599121E-02     速度提升了 27.5152661993683 倍