如何复制单元格将其粘贴到Excel VBA宏中的多个单元格中 [英] How to copy a cell & paste it to multiple cells in Excel VBA Macro

问题描述

我要复制金额并将其粘贴到金额上方的所有空白单元格中如图所示图片，在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

此代码仅在此表上有效.如果内容更改，则无法正常工作.例如:如果添加了更多项目，则会给出不同的输出.

任何人都可以帮助我解决该问题.预先感谢.

解决方案

就值复制的逻辑而言，我认为这是您需要解决的问题.但是我确实对如何到达那里有一些提示.

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

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()中使用的一样.

您可以将所有这些片段拼凑在一起以创建一个您想要的宏吗?您应该:a)检查表中有多少行，b)向下浏览单元格并检查目标中的单元格是否为空，c)如果是，则从源中的同一行复制.

I want to copy the amount and paste it to all empty cells above the amount as shown in the picture , using VBA or Macro in MS Excel

Edit: This is what I done it.

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

This code only works on this table only. If contents change it's not working. eg: if more items added, it's giving different outputs.

Can anyone help me to resolve it. Thanks in advance.

解决方案

As far as the logic of the copying of values, I think this is something you need to work out. But I do have some hints of how to get there.

Do NOT use Select/Copy/Paste - Use direct assignment instead

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

This will take the one value in cell F5 and use it to assign the three cells G5:G7.

To pick a specific value in a table, use the .Cells() function

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

To count the number of rows down, or column across that have values use the following functions (placed in a module).

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

To be used as

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)

To check if a cell is empty, use IsEmpty() just like I have used in CountRows().

Can you piece all these pieces together to make a macro that does what you want? You should: a) check how many rows are in the table, b) go down the cells and check if they are empty in the destination and c) if they are, copy from the same row in the source.

这篇关于如何复制单元格将其粘贴到Excel VBA宏中的多个单元格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！