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

Question

Iv'e been breaking my head over this.

My first sheet contains these buttons:

ImageButtons

With this being the transportFile:

transportFile

So I'm trying to make it so that just the rows that contain (in this case) January and february dates get pasted to the "2016" sheet.

This is the code that I'm using right now:

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" and "febrCount" represent the numbers of rows that contain January and february dates. This is being calculated in the transportFile with

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

and

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

Afterwards, I run a loop that deletes the empty rows in the 2016 sheet.

Now I have 2 questions:

1. In the sumproduct formula of January I had to reduce the range because excel counts every empty cell as a January one. It's almost October, so that's not a problem now. But in 2017, when there's no data yet, there will be 150 January dates. How can I solve that?
2. If someone (by mistake) puts a March in between the Februaries, my ranges get all messed up. How can I avoid this?

Answer 1

If your column with dates is formatted properly as date, then why don't check for value of month(cell)?

You could do check for each combobox while looping through all cells in column A like

 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
      ....

As for 1. " excel counts every empty cell as a January one" probably they can be excluded somehow, a crude way would be to do exact same sumproduct for all empty cells in a column and subtract them :)

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

EDIT

Ok I had to check the sumproduct, correct way is to use second array to check for cells that are non empty:

=SUMPRODUCT(--(MONTH($A$2:$A$37)=1);--(($A$2:$A$37)<>"")) This will return count of cells that have month(cell)=1 AND cell.value <> empty so you don't get false count for January when empty cell returns month=1

As for 2 if you would make the loop using VBA to go through all your data then it doesn't matter if they are in order or not as each cell month value will be read, irrespectively of order.

EDIT 2

I will not propose the solution for this option but maybe the Pivot table could be the good solution for that task? VBA code could be use to modify displayed data in the pivot table depending on the selected checkboxes.

Answer 2

This code will look at each checkbox on the sheet to decide which has been ticket (assuming the only checkboxes you have are for months and they're all named CheckBoxMMMMM ).

It then filters by those months and copies the filtered rows to the final sheet.

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

From what I can find on the internet the numerical value given to the array (1) returns all values in that month. Other values available are:

• 0 year
• 1 month
• 2 day
• 3 hour
• 4 minute
• 5 second