VBA : 从 2 列或更多列复制值并将它们粘贴到 1 列而不覆盖值

Question

我是 VBA 的新手，这是我第一次 post 在这里，所以请原谅我的业余问题，但是我如何从 2 列或更多列复制值并将它们粘贴到 1列而不覆盖值（即连续粘贴在单个列中的值）......包含值的列是要粘贴到 AB 列中的 U、V 和 W......

请查找以下代码：

Private Sub CommandButton1_Click()

Dim a As Integer
Range("u1").Select
Noofcolumns = Range(Selection, Selection.End(xlToRight)).Columns.Count

For i = 1 To Noofcolumns
    Cells(1, 20 + i).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    For j = 1 To 500
        a = Cells(j, 28).Value
        If IsEmpty(a) Then
            Cells(j, 28).Select
            Selection.PasteSpecial Paste:=xlPasteValues
        Else: GoTo 1
        End If
    Next j

Next i

End Sub

Answer 1

您需要考虑的一些事项：

阅读 how to avoid the use of .Select。我认为这里是 SO 上分享最多的 post 之一，也是更好地参考 Range object.
要基于第一点，您需要明确引用 Range objects。例如 Range("u1").Select 将在当前活动的工作表上 select U1。相反，至少，使用工作表参考（即使是工作簿参考也可能更好）
其次，您已使用 XlToRight 检索上次使用的列。如果这是你的意图，那可能就好了。但是为了将来的参考，如果您的数据存在差距，您可能会得到 Range 不满意的结果。 XlToLeft 可能更好，例如下面会在第一行从右到左找到最后使用的列：
```
With Sheet1
    LastColumn = .Cells(1, sht.Columns.Count).End(xlToLeft).Column
End with
```
在你的情况下，甚至可能不需要这样的评估，因为你的值在列 U:W 中，而你可以只使用 For x = # to # 循环。
当您要查找上次使用的行时同样如此。空白单元格可能会影响 XlDown，但 XlUp 会反击。可以找到关于查找最后一行的更深入 post here，也是一个非常有价值的 SO post。例如，下面将从 A 列获取最后使用的行：
```
With Sheet1
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End with
```
还有就是不需要用Copy传值，直接传值即可，例如（简体）：
```
With Sheet1
    .Cells(1, 1) = .Cells(1, 2)
End with
```
另一个（次要）点是使用 Integer 数据类型变量没有用。如果误用导致错误，它们很容易溢出。你最好使用 Long 数据类型。
尽量避免 Goto 语句，这会导致意大利面条式代码，在你的情况下甚至没有语句丢失（goto 实际上无处可去）

现在有了这些点你可以尝试改变你的代码，现在看起来像下面这样：

_{示例数据：}

_{示例代码：}

Private Sub CommandButton1_Click()

'Dimming our variables properly
Dim lr1 As Long, lr2 As Long, x As Long

'Using an explicit sheet reference
With Sheet1

    'Looping over the columns U:W
    For x = 21 To 23

        'Getting the last used row from the column
        lr1 = .Cells(.Rows.Count, x).End(xlUp).Row

        'Getting the last used row from column J
        lr2 = .Cells(.Rows.Count, 28).End(xlUp).Row + 1

        'Transfer data directly
        .Cells(lr2, 28).Resize(lr1 - 1).Value2 = .Range(.Cells(2, x), .Cells(lr1, x)).Value2

    'Continue to next column in iteration
    Next x

End With

End Sub

_结果：

以上都是假设您在所有这些列中都有一个 header。如果不是，只需相应调整即可。

VBA : 从 2 列或更多列复制值并将它们粘贴到 1 列而不覆盖值

VBA : Copy values from 2 or more columns and paste them in 1 column without overwriting the values

excel

vba

copy-paste