VBA Excel - 有没有办法只复制月份（A列）相等的行，例如一月，然后将其粘贴到另一张纸上？

Question

我一直为此头疼。

我的第一张工作表包含这些按钮：

ImageButtons

这是传输文件：

transportFile

因此，我尝试将仅包含（在本例中）1 月和 2 月日期的行粘贴到“2016”工作表中。

这是我现在使用的代码：

If CheckBoxJanuary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(2, 1), Worksheets("2016").Cells(janCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(2, 1), Worksheets("transportFile").Cells(janCount, 13)).Value
End If

If CheckBoxFebruary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(janCount + 1, 1), Worksheets("2016").Cells(janCount + febCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(janCount + 1, 1), Worksheets("transportFile").Cells(janCount + febCount, 13)).Value
End If

“janCount”和“febrCount”表示包含一月和二月日期的行数。这是在传输文件中使用

计算的

"=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))"

和

"=SUMPRODUCT(--(MONTH($A$2:$A$1500)=2))"

之后，我运行一个循环来删除 2016 工作表中的空行。

现在我有两个问题：

1. 在一月份的 sumproduct 公式中，我不得不缩小范围，因为 excel 将每个空单元格计为一月份的单元格。现在快十月了，所以现在这不是问题。但在 2017 年，当还没有数据时，将有 150 个 1 月日期。我该如何解决？
2. 如果有人（错误地）在二月之间设置了三月，我的范围就会一团糟。我怎样才能避免这种情况？

Answer 1

如果您的日期列正确格式化为日期，那么为什么不检查月份（单元格）的值？

您可以在遍历 A 列中的所有单元格时检查每个组合框 喜欢

 If combo box "January" selected Then
      'month = 1 and non empty
      If (Month(Cells(i, 1).Value) = 1) And (Cells(i, 1) <> "") Then  
           'copy your rows to new sheet
      End if
 End if
 If combo box "Feb" selected Then
      'month = 2 and non empty
      ....

至于 1.“excel 将每个空单元格计为 1 月单元格”可能会以某种方式排除它们，一种粗略的方法是对列中的所有空单元格执行完全相同的 sumproduct 并减去它们 :)

=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))-SUMPRODUCT(--(($A$2:$A$150)=""))

编辑

好的，我必须检查 sumproduct，正确的方法是使用第二个数组来检查非空单元格：

=SUMPRODUCT(--(MONTH($A$2:$A$37)=1);--(($A$2:$A$37)<>"")) 这将返回具有 month(cell)=1 AND cell.value empty 的单元格计数，因此当空单元格返回 month=1

时，您不会得到一月份的错误计数

至于 2，如果您使用 VBA 进行循环来遍历所有数据，那么它们是否按顺序排列并不重要，因为每个单元格月份值都会被读取，而与顺序无关。

编辑 2

我不会为此选项提出解决方案，但也许数据透视表可能是该任务的良好解决方案？ VBA 代码可用于根据选中的复选框修改数据透视表中显示的数据。

Answer 2

此代码将查看工作表上的每个复选框以确定哪个已被票（假设您拥有的唯一复选框是几个月，并且它们都被命名为 CheckBoxMMMMM）。

然后它会按这些月份进行过滤，并将过滤后的行复制到最后一张表中。

Sub CopyFiltered()

    Dim wrkSht As Worksheet
    Dim shp As Shape
    Dim FilterMonths As Collection
    Dim vItem As Variant
    Dim rLastCell As Range
    Dim rFilterRange As Range
    Dim vFilterString() As Variant
    Dim x As Long

    Set wrkSht = ThisWorkbook.Worksheets("TickBoxSheet")
    Set FilterMonths = New Collection

    'Get a collection of ticked dates.
    'This works by looking at each checkbox on the sheet.
    'It assumes they're all called 'CheckBoxMMMM' so it can build a real date from the name.
    For Each shp In wrkSht.Shapes
        If shp.Type = msoFormControl Then
            If shp.FormControlType = xlCheckBox Then
                If shp.ControlFormat.Value = 1 Then
                    FilterMonths.Add DateValue("1 " & Replace(shp.Name, "CheckBox", ""))
                End If
            End If
        End If
    Next shp

    'Create an array of "1 ,<date>,1 ,<2nd date>"
    x = 1
    ReDim vFilterString(1 To FilterMonths.Count * 2)
    For Each vItem In FilterMonths
        vFilterString(x) = 1
        vFilterString(x + 1) = Format(vItem, "m/d/yyyy")
        x = x + 2
    Next vItem

    'Apply the filter - the commented line works but is hardcoded.
    'The other filter line appears to be the same as the commented line, but isn't working....
    With ThisWorkbook.Worksheets("2016")
        If .AutoFilterMode Then .AutoFilterMode = False
        Set rLastCell = Sheet2.Cells.Find(What:="*", After:=.Cells(1, 1), SearchDirection:=xlPrevious)
        Set rFilterRange = .Range(.Cells(1, 1), rLastCell)
        rFilterRange.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=vFilterString

        'Copy the visible filtered cells to the transportfile sheet.
        .Range(.Cells(1, 1), rLastCell).SpecialCells(xlVisible).Copy Destination:=ThisWorkbook.Worksheets("transportfile").Range("A1")

    End With

End Sub

从我在互联网上可以找到的给数组 (1) 的数值返回该月的所有值。其他可用值是：

• 0 年
• 1 个月
• 2 天
• 3 小时
• 4 分钟
• 5 秒