Question

我有以下用于excel的VBA代码

  Dim k As Integer, z As Integer
Dim sourceSht As Worksheet
Dim destSht As Worksheet

z = 0

Set sourceSht = Sheets("sheet1")
Set destSht = Sheets("sheet2")
DoEvents
For k = 1 To 5000
    If k < 3 Or (k - 1) Mod 3 <> 0 Then
        z = z + 1
        sourceSht.Columns(k).Copy destSht.Columns(z)
    End If
Next

此代码适用于行（更改此部分“sourceSht.Columns（k）.Copy destSht.Columns（z）”）。

但我不能让它适用于列。我希望excel复制前2列，然后跳过第3列，然后再复制2，跳过1等等......有人可以帮助我并解释我做错了什么吗？

Answer 1

我将忽略mod的使用，并使用循环执行第3步：

Dim i as Long, j as Long
For i = 1 to 5000 Step 3
    With sourceSht
        If j = 0 Then
            j = 1
        Else
            j = j + 2 'Copying 2 columns over, so adding 2 each time
        End If
        .Range(.Columns(i),.Columns(i+1)).Copy destSht.Range( destSht.Columns(j), destSht.Column(j+1))
    End With
Next i

这样的事情应该为你做到

Answer 2

替代：

Sub tgr()

    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim rCopy As Range
    Dim rLast As Range
    Dim LastCol As Long
    Dim i As Long

    Set wsSource = ActiveWorkbook.Sheets("Sheet1")
    Set wsDest = ActiveWorkbook.Sheets("Sheet2")

    On Error Resume Next
    Set rLast = wsSource.Cells.Find("*", wsSource.Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
    On Error GoTo 0
    If rLast Is Nothing Then Exit Sub   'No data
    LastCol = rLast.Column

    Set rCopy = wsSource.Range("A:B")
    For i = 4 To LastCol Step 3
        Set rCopy = Union(rCopy, wsSource.Columns(i).Resize(, 2))
    Next i
    rCopy.Copy wsDest.Range("A1")

End Sub

Answer 3

试试这个（使用count表示你需要复制列的时间，t表示你需要复制的第一列）：

Sub copy_columns()

t = 1
Count = 1

Do Until Count = 10

Range(Columns(t), Columns(t + 1)).Copy
Cells(1, t + 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
t = t + 3
Count = Count + 1

Loop

End Sub

Excel VBA复制特定列

3 个答案: