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

Question

我为此一直在挣扎。

我的第一张纸包含以下按钮：

图像按钮

以此为transportFile：

transportFile

因此，我试图做到这一点，以便仅将包含（在这种情况下）一月和二月日期的行粘贴到“ 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”表示包含一月和二月日期的行数。 这是在transportFile中使用

“ = SUMPRODUCT（-（MONTH（$ A $ 2：$ A $ 150）= 1））”

和

“ = SUMPRODUCT（-（MONTH（$ A $ 2：$ A $ 1500）= 2））”

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

现在我有两个问题：

1. 在一月份的sumproduct公式中，我不得不缩小范围，因为excel将每个空单元格都计为一月份。 快到十月了，所以现在不成问题了。 但是在2017年，当没有数据时，将有150个1月日期。 我该如何解决？
2. 如果有人（由于错误）在2月之间插入了3月，则我的范围将全部混乱。 如何避免这种情况？

Answer 1

如果您带有日期的列的格式正确地设置为日期，那么为什么不检查month（cell）的值呢？

您可以在遍历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将每个空单元格都计为一月一个”可能可以以某种方式排除它们，一种粗略的方法是对列中的所有空单元格进行完全相同的求和并减去它们:)

=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 <>为空，因此当空单元格返回month = 1时，您不会获得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秒