如何复制单元格并将其粘贴到 Excel VBA 宏中的多个单元格

Question

我想复制金额并将其粘贴到金额上方的所有空单元格中，如图所示，在 MS Excel 中使用 VBA 或宏

编辑：这就是我所做的。

Sub Macro2()
    Range("F5").Select
    Selection.Copy
    Range("F2:F4").Select
    ActiveSheet.Paste
    Range("F7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F6").Select
    ActiveSheet.Paste
    Range("F12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F8:F11").Select
    ActiveSheet.Paste
End Sub

此代码仅适用于此表。 如果内容更改，则无法正常工作。 例如：如果添加更多项目，则会提供不同的输出。

任何人都可以帮我解决它。 提前致谢。

Answer 1

至于复制值的逻辑，我认为这是您需要解决的问题。 但我确实有一些关于如何到达那里的提示。

不要使用选择/复制/粘贴-使用直接分配，而不是

Range("G5").Resize(3, 1).Value = Range("F5").Value

这将采用单元格F5的一个值并使用它来分配三个单元格G5:G7 。

要在表中选择特定值，请使用.Cells()函数

For i=1 to 10
  Range("B2").Cells(i,1).Value = Range("A2").Cells(i,1).Value
Next i

要向下计数行数或具有值的列数，请使用以下函数（放置在模块中）。

Public Function CountCols(ByVal r As Range) As Long
    If IsEmpty(r) Then
        CountCols = 0
    ElseIf IsEmpty(r.Offset(0, 1)) Then
        CountCols = 1
    Else
        CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
    End If
End Function

Public Function CountRows(ByVal r As Range) As Long
    If IsEmpty(r) Then
        CountRows = 0
    ElseIf IsEmpty(r.Offset(1, 0)) Then
        CountRows = 1
    Else
        CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
    End If
End Function

用作

Dim n as Long
' Count rows in table starting from A2
n = CountRows(Range("A2"))
Dim r as Range
' Set a range reference to n×1 cells under A2
Set r = Range("A2").Resize(n,1)

要检查单元格是否为空，请使用IsEmpty()就像我在CountRows()使用的CountRows() 。

你能拼凑这些碎片拼凑起来，做一个宏，你想要做什么？ 您应该：a) 检查表中有多少行，b) 向下移动单元格并检查它们在目标中是否为空，c) 如果是，则从源中的同一行复制。