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秒