Question

我创建了以下宏

我的数据一直到主数据表中的第3710行 - 我不知道如何强制这个宏循环并包含所有数据

Sub Macro3()
'
' Macro3 Macro
'

'
    Range("A1:A2").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1:B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Sheet1").Select
    Range("A3:A4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2:B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
End Sub

Answer 1

您可以使用for循环执行此操作。另外，复制/粘贴是我们在VBA以及.SELECT和.ACtivate中通常会回避的问题。这些是人类执行的功能，但计算机可以将单元格设置为等于其他单元格的值，如：

 Sheets("Sheet1").Cells(1, 1).value = Sheets("Sheet2").Cells(1,1).value

其中说Sheet1中的单元格“A1”应设置为Sheet2单元格“A1”中的值。

更改内容，实现循环以执行转置，并使用一些快速线性回归公式来确定要写入的行：

Sub wierdTranspose()
    'Loop from row 1 to row 3710, but every other row
    For i = 1 to 3710 Step 2    
        'Now we select from row i and row i + 1  (A1 and A2, then A3 and A4, etc)
        'And we put that value in the row of sheet2 that corresponds to (.5*i)+.5
        '   So if we are picking up from Rows 7 and 8, "i" will be 7 and (.5*i)+.5 will be row 4 that we paste to
        '   Then the next iteration will be row 9 and 10, so "i" will be 9 and (.5*i)+.5 will be row 5 that we paste to 
        '   and on and on until we hit 3709 and 3710...
        Sheets("Sheet2").Cells((.5*i)+.5, 1).value = Sheets("Sheet1").Cells(i, 1).value
        Sheets("Sheet2").Cells((.5*i)+.5, 2).value = Sheets("Sheet1").Cells(i+1, 1).value
    Next i
End Sub

Answer 2

批量数据最好通过VBA阵列传输，无需复制/粘贴。

这样的事情：

Sub SplitColumn()
    Dim A As Variant, B As Variant
    Dim i As Long
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)

    With ws1
        A = .Range(.Cells(1, 1), .Cells(3710, 1))
    End With

    ReDim B(1 To 1855, 1 To 2)
    For i = 1 To 1855
        B(i, 1) = A(2 * i - 1, 1)
        B(i, 2) = A(2 * i, 1)
    Next i

    With ws2
        .Range(.Cells(1, 1), .Cells(1855, 2)).Value = B
    End With

End Sub

Excel宏单列转置为两列

2 个答案: