隔列提取的代码

excelnew1

极速隔列提取的代码

719404338

1. Sub t()
   
2. Dim i%, j%, str$
   
3. i = 1
   
4. For j = 2 To 22 Step 3
   
5. Sheet2.Select
   
6. str = Cells(1, j)
   
7. Sheet2.Cells(1, i) = str
   
8. i = i + 1
   
9. Next
   
10. End Sub
    

复制代码

alstar

Sub TEST()
r = [1:1].Count
For i = 2 To r Step 3
    n = n + 1
    Sheets(2).Cells(1, n) = Cells(1, i)
Next
Sheets(2).[a1] = Cells(1, 2)
End Sub

excelnew1

719404338 发表于 2018-9-30 10:36

老师如果数据不至一行的情况代码如何改下。

719404338

Cells(1, j)中的1用变量代替，建议上传附件。

xd3210

excelnew1 发表于 2018-9-30 10:47
老师如果数据不至一行的情况代码如何改下。

Sub TEST()
    Dim ir As Integer
    Dim ic As Integer
    Sheet1.Select
    ir = Range("b65536").End(xlUp).Row
    For j = 1 To ir
        ic = Cells(j, Columns.Count).End(xlToLeft).Column
        n = 0
        For i = 2 To ic Step 3
            n = n + 1
            Sheets(2).Cells(j, n) = Cells(j, i)
        Next
    Next
End Sub

lsc900707

1. Sub gj23w98()
   
2.     arr = [b1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         For j = 1 To UBound(arr, 2) Step 3
   
7.             n = n + 1
   
8.             brr(m, n) = arr(i, j)
   
9.         Next
   
10.     Next
    
11.     If m Then Sheet2.[a1].Resize(m, n) = brr
    
12. End Sub

复制代码