Question

我在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和空单元格）你可以指导我的任何简单技巧？

Answer 1

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

TRY：

    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

Answer 2

您可以使用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

具有条件的Excel宏复制粘贴

2 个答案: