Excel宏 - 仅将非空单元格从一个工作表粘贴到另一个工作表

时间:2013-01-24 07:11:32

标签: excel-vba copy-paste vba excel

下面是我用来从一张纸上复制单元格并粘贴到另一张纸上的代码。

Sheets("codes").Select
Range("A5:A100").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B28").Select
ActiveSheet.Paste

这个问题是这个范围内的一些单元格是空白但我不希望它们被复制到Sheet2。我从here得到了一些想法,但这个方法太长了。有没有办法可以迭代选择并检查值是否为非空并粘贴。这样我也可以在空白单元格中粘贴一些其他文本(例如#NA)。

3 个答案:

答案 0 :(得分:9)

看起来你可能在这里犯了一些常见的菜鸟错误(我们都做到了,这没关系)。


具有逐行说明的VBA示例

提示:尽量不要使用“选择”或“复制”。为什么使用select当你需要做的就是引用单元格本身?例如,而不是使用

Sheets("codes").Select
Range("A5:A100").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B28").Select
ActiveSheet.Paste

只需使用

dim mySheet as Worksheet, myOtherSheet as Worksheet, myBook as Workbook 'Define your workbooks and worksheets as variables
set myBook = Excel.ActiveWorkbook
set mySheet = myBook.Sheets("codes")
set myOtherSheet = myBook.Sheets("Sheet2")

dim i as integer, j as integer 'Define a couple integer variables for counting

j = 28 'This variable will keep track of which row we're on in Sheet2 (I'm assuming you want to start on line 28)
for i = 5 to 100 'This is the beginning the the loop which will repeat from 5 to 100 . . .
   if mySheet.Cells(i,1).value <> "" then ' . . . for each digit, it will check if the cell's value is blank. If it isn't then it will . . .
      myOtherSheet.Cells(j,2).value = mySheet.Cells(i,1).value ' . . . Copy that value into the cell on Sheet2 in the row specified by our "j" variable.
      j = j + 1 'Then we add one to the "j" variable so the next time it copies, we will be on the next available row in Sheet2.
   end if
next i 'This triggers the end of the loop and moves on to the next value of "i".

我第一次开始的时候总是做同样的事情,而且它永远不会正确。 “选择”会导致左右错误。使用我的代码,阅读评论,你会没事的。 快速警告:我在这台计算机上没有Excel,因此无法测试代码。如果它由于某种原因不起作用,请给我留言,明天我会在工作中解决它。

将数据复制到第二张纸时,上面的代码将完全省略空白单元格。如果您想为空白单元格输入某个文本(例如“N / A”),则可以使用以下内容:

 dim mySheet as Worksheet, myOtherSheet as Worksheet, myBook as Workbook 'Define your workbooks and worksheets as variables
 set myBook = Excel.ActiveWorkbook
 set mySheet = myBook.Sheets("codes")
 set myOtherSheet = myBook.Sheets("Sheet2")

 dim i as integer, j as integer 'Define a couple integer variables for counting

 j = 28 'This variable will keep track of which row we're on in Sheet2 (I'm assuming you want to start on line 28)
 for i = 5 to 100 'This is the beginning the the loop which will repeat from 5 to 100 . . .
    if mySheet.Cells(i,1).value <> "" then ' . . . for each digit, it will check if the cell's value is blank. If it isn't then it will . . .
       myOtherSheet.Cells(j,2).value = mySheet.Cells(i,1).value ' . . . Copy that value into the cell on Sheet2 in the row specified by our "j" variable.
    else 'If the cell is blank, then . . .
       myOtherSheet.Cells(j,2).value = "N/A" ' . . . place the text "N/A" into the cell in row "j" in Sheet2.
    end if 'NOTICE we moved the "end if" statement up a line, so that it closes the "if" statement before the "j = j + 1" statement. _
      This is because now we want to add one to the "j" variable (i.e., move to the next available row in Sheet2) regardless of whether the cell in the "codes" sheet is blank or not.
       j = j + 1 'Then we add one to the "j" variable so the next time it copies, we will be on the next available row in Sheet2.
 next i 'This triggers the end of the loop and moves on to the next value of "i".

答案 1 :(得分:3)

简单:

  Sheet1.Range("A1:a500").SpecialCells(xlCellTypeConstants).Copy Sheet2.Range("b2")

我使用xlCellTypeConstants,但还有很多其他可能性。

Sheet1通常相当于Sheets("Sheet1")。第一个是VBE(程序员视图)中的名称,第二个是用户界面中的名称(用户视图)。我通常更喜欢第一种语法,因为它更短,并允许重命名工作表(对于用户)而不会影响代码。

答案 2 :(得分:1)

如果您不需要格式化,我会使用以下内容。它只是将您在工作表上指定的范围复制到变量,循环遍历该变量,检查空单元格并放入您喜欢的任何字符串。这很好,很快。如果要保留格式,可以将特殊格式粘贴到输出范围。

Sub CopyNonBlankCells(rFromRange As Range, rToCell As Range, sSubIn As String)
    'You have three inputs.  A range to copy from (rFromRange), a range to copy to (rToCell) and a string to put in the blank cells.        

    Dim vData As Variant, ii As Integer, jj As Integer

   'Set to a variable since it's quicker
    vData = rFromRange.Value

    'Loop through to find the blank cells
    For ii = LBound(vData, 1) To UBound(vData, 1)   'Loop the rows
        For jj = LBound(vData, 2) To UBound(vData, 2)    'Loop the columns
            'Check for empty cell.  Quicker to use Len function then check for empty string
            If VBA.Len(vData(ii, jj)) = 0 Then vData(ii, jj) = sSubIn
        Next jj
    Next ii

    'Output to target cell.  Use the 'With' statement because it makes the code easier to read and is more efficient
    With rToCell.Parent
        .Range(.Cells(rToCell.Row, rToCell.Column), .Cells(rToCell.Row + UBound(vData, 1) - 1, rToCell.Column + UBound(vData, 2) - 1)).Value = vData
    End With

End Sub

并将其命名为:

Call CopyNonBlankCells(Sheets("codes").Range("A5:A100"), Sheets("Sheet2").Range("B28"), "Non-blank")