Question

亲爱的StackOverflow社区，

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

我想：

从工作表中选择每个第3个单元格（在我的情况下为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
```

从同一张纸张中选择每个第3个单元格，但从另一个偏移量（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开始删除每一行（与上面相同
准备好复制（只需通常的复制命令，也已完成）

所以当你看到我需要一个技巧来复制单个单元格并将它们粘贴到它上面的单元格中而不会覆盖它（因此来自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次才能正确复制和粘贴文本）

第二部分：有关选择每一个第二/第三行而不是列中每个第二/第三单元的任何帮助吗？

到目前为止，我对此感到敬畏（感谢您的建议）如下：

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

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

Answer 1

我认为这就是你的意思：

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

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

Answer 2

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

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中的值。查找偏移函数以获取更多信息

Answer 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行。这有帮助吗？

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

3 个答案: