Excel 宏复制粘贴条件答案

【问题标题】：Excel Macro copy paste with conditionsExcel 宏复制粘贴条件
【发布时间】：2018-05-15 16:27:13
【问题描述】：

我在 excel 中有一个宏，它可以工作，但并不像我想要的那样完美。找不到解决方案，需要你的想法。

它的作用是：从设置粘贴值复制到计算表中的第一个非空单元格。它没问题

这是我的代码：

Sub support()
Sheets("Settings").Select
Range("S411:S421").Select
Selection..Copy
Sheets("Calculation").Select
Range("C4").Select
Range("C4").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

但我只想将非空单元格和不为 0 的值复制到这 10 行之间的计算页面。（所以我应该跳过复制 0 和空单元格）你可以指导我有什么简单的技巧吗？

【问题讨论】：

标签： vba excel

【解决方案1】：

你可以使用AutoFilter()

Sub support()
    With Sheets("Settings").Range("S410:S421") '<--| reference wanted range and the cell above it as the "header"
        If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1).Value = "dummyheader" '<--| add a "dummy" header value if it's empty
        .AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>0" '<--| filter referenced range with "not empty" and "not zero" values
        If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
            .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
            Sheets("Calculation").Range("C4").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents '<--| remove "dummy" header, if there
        .Parent.AutoFilterMode = False
    End With
End Sub

【讨论】：

哇，这是个好主意，而且效果很好。我对自己很生气，我没想到自动过滤器:(
只是补充一点，如果您确定 S410 单元格始终不为空，那么您可以省略 If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1).Value = "dummyheader" 和 If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents 语句
谢谢你很可能不会是空的，但不能确定。随着时间的推移，我会看到并记住这一点，再次感谢你。

【解决方案2】：

您想每次都从Range("S411:S421") 复制到Range("C4")..-> 吗？或者这些范围可以更改？

尝试：

    Public Sub CommandButton1_Click()
j = 4
For i = 411 To 421

If ThisWorkbook.Sheets("Settings").Cells(i, 19) <> 0 And ThisWorkbook.Sheets("Settings").Cells(i, 19) <> "" Then
ThisWorkbook.Sheets("Settings").Cells(i, 19).Copy

ThisWorkbook.Sheets("Calculation").Cells(j, 3).PasteSpecial (xlPasteValues)
j = j + 1
End If


Next i
End Sub

【讨论】：

是的，我想在每次相同的单元格和范围没有改变时复制。但行在我过去的地方发生了变化。
Range("S411:S421") 我复制的地方包含公式，因此每次都有不同的值。
是的，例如，当您在范围 S411:S421 中有 (10,0,-,0,-,45,78,96,0,-,121) 时，您希望拥有 (10 ,45,78,96,121) 在 C4 及以下，是吗？