Excel VBA 从每个第 n 个单元格复制内容并粘贴到每个第 n 个单元格中答案

【问题标题】：Excel VBA Copy content from every nth cell and paste into every nth cellExcel VBA 从每个第 n 个单元格复制内容并粘贴到每个第 n 个单元格中
【发布时间】：2016-11-10 03:15:06
【问题描述】：

尊敬的 StackOverflow 社区，

我通过 Excel 进行财务管理只是为了跟踪我的财务状况。我正在使用来自我的银行网站的原始数据，并有一个宏来对数据进行更少的排序，并准备好进行复制粘贴。但是我创建的宏并没有真正让我满意，我正在考虑如何在 Visual Basic for Application 中执行以下操作：

我想：

从工作表中选择每第三个单元格（在我的情况下为 B3）（完成）

Dim rRange As Range
Dim rEveryNth As Range
Dim lRow As Long        

With Tabelle5
    Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3
    If lRow = 1 Then
        Set rEveryNth = rRange(lRow, 1)
    Else
        Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
    End If
Next lRow

Application.Goto rEveryNth

在这些单元格之后放置一个空格（就像在每个单元格之后按空格键一样）（完成）
```
Dim c As Range

For Each c In Selection
    If c.Value <> "" Then c.Value = c.Value & " "
Next
```

从同一张表中选择每个第三个单元格，但从另一个偏移量 (B4)（完成）

With Tabelle5
    Set rRange = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3
    If lRow = 1 Then
        Set rEveryNth = rRange(lRow, 1)
    Else
        Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
End If
Next lRow

Application.Goto rEveryNth

复制这些单元格的文本，然后将它们粘贴到从 B3 开始的每 3 个单元格中，而不从单元格中删除原始文本（此处需要帮助）
从 B4 开始每隔 3 行删除一次（也需要帮助）
从B2开始每隔2行删除一次（同上
准备好复制（只是通常的复制命令，也完成了）

因此，正如您所见，我需要一个技巧来以某种方式复制单个单元格并将它们粘贴到其上方的单元格中而不覆盖它（因此 B4 中的文本被复制并粘贴到 B3 中，从 B7 到 B6 等也是如此）

我尝试使用以下命令：

    With Tabelle5
        Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    End With

    For lRow = 1 To rRange.Rows.Count Step 3
        If lRow = 1 Then
            Set rEveryNth = rRange(lRow, 1)
        Else
            Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
        End If
    Next lRow
    Application.Goto rEveryNth

    For Each c In Selection
    If c.Value <> "" Then c.Value = c.Value & rEveryNth
    Next

唯一的问题是它只粘贴我拥有的最后一个单元格中的文本并将文本粘贴到所有其他单元格中，这不是我想要的。

是否有任何重复命令可以选择一个单元格，复制文本，将其粘贴到上面的单元格而不覆盖它？如果是，我该怎么做？（我必须总共做 20 次才能正确复制和粘贴文本）

对于第二部分：关于选择每个第 2/3 行而不是每列中的每个第 2/3 个单元格有什么帮助吗？

到目前为止，我所经历的（感谢您的建议）如下：

Dim rRange As Range
Dim rEveryNth As Range
Dim lRow As Long

With Tabelle5
    Set rRange = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3
    If lRow = 1 Then
        Set rEveryNth = rRange(lRow, 1)
    Else
        Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
    End If
Next lRow
Application.Goto rEveryNth

Range(rEveryNth.Address).Offset(-1, 0).Value = rEveryNth.Value

End Sub

但它仍然会复制最后一个单元格并将其粘贴到其他每个单元格中...

【问题讨论】：

“将其粘贴到上面的单元格而不覆盖它”应该发生什么而不是覆盖现有内容？不清楚你想在这里发生什么。
我的目标是复制选定的单元格（从 B4 开始的每个第 3 个单元格，其中包含通常直到 B61 的文本）并将这些选定单元格的内容粘贴到上面的单元格中（所以来自 B4 的文本粘贴到 B3 中，从 B7 到 B6 等）而不覆盖它们
如果您将一个单元格复制并粘贴到另一个单元格中，那么目标单元格的内容将被覆盖 - 应该发生什么？我认为用您正在寻找的具体示例更新您的问题会很有帮助。
这就是我认为这样可以方便地将一些信息粘贴到单元格中而不覆盖它们Dim c As Range For Each c In Selection If c.Value <> "" Then c.Value = c.Value & " " Next

标签： vba excel

【解决方案1】：

要从单元格中复制数据并将其粘贴到上面的单元格中，您可以尝试以下操作：

currentRange.offset(-1,0).value = currentRange.value

这会将 currentRange 上方的单元格的值设置为 currentRange 的值，并且不会触及 currentRange 中的值。

例如，

set rng = range("B7") range(rng.address).offset(-1,0).value = rng.value

将 B6 中的值设置为 B7 中的值。查找偏移函数以获取更多信息

【讨论】：

我只是试图将代码复制粘贴到我的宏中进行删除，它说“需要对象”并突出显示该字符串...我必须如何定义它？
我以 currentRange 为例。尝试将该行放入您的代码中，但将 currentRange 替换为您要复制并粘贴到上述单元格中的范围。如果您更新问题，我可以看看

【解决方案2】：

我认为这就是你的意思：

Dim rRange As Range, c As Range, lRow As Long

With Tabelle5
    Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3

    Set c = rRange.Cells(lRow)

    c.Value = c.Value & " " & c.Offset(1,0).Value

Next lRow

通过建立这些联合范围，您的代码过于复杂......

【讨论】：

是的，这正是我想要的。非常感谢！（对于过于复杂的情况感到抱歉：D）

【解决方案3】：

Option Explicit
Sub test()

Dim ws As Worksheet
Dim i As Integer
Dim copyvalue As String
Dim copyvalue2 As String
i = 1

For Each ws In ThisWorkbook.Worksheets
    ActiveWorkbook.Worksheets(i).Select
    copyvalue = Range("B3").Value
    copyvalue2 = Range("B4").Value
    Range("B3") = copyvalue & " " & copyvalue2
    Range("B5").Select
    Selection.EntireRow.Delete
    Range("B6").Select
    Selection.EntireRow.Delete
    i = i + 1
Next ws

End Sub

这将循环遍历每个工作表并将 B3 和 B4 组合起来，然后删除第 5 行和第 7 行。这有帮助吗？

【讨论】：