问题
I have a sheet (named "UserInput") with data from 1959-2013 (starting at 10/1/1959)
i.e.:
"UserInput" Sheet
Column A Column C Column I
DATE UNGAGED FLOW PERM. WITHDRAWAL & PASS
Row 24: 10/1/1959 9.3 7.7
10/2/1959 5.2 6.4
10/3/1959 6.3 4.3
10/4/1959 3.8 7.5
...
...
Row 19839: 12/31/2013 5.5 9.1
I need to write a macro that filters by month starting from A24, then pastes the date, 'ungaged flow' (starting at C24) and 'permitted withdrawal and passby' (starting at I24) values for each day to its corresponding sheet (I have separate sheets named "OCTOBER", "NOVEMBER", "DECEMBER", etc. with "ungaged flow" and "permitted withdrawal and passby" columns)
i.e.:
"OCTOBER" Sheet
Column A Column B Column C
DATE UNGAGED FLOW PERM. WITHDRAWAL & PASS
Row 3: 10/1/1959 9.3 7.7
10/2/1959 5.2 6.4
10/3/1959 6.3 4.3
...
...
10/1/1960 n n
10/2/1960 n n
...
...
10/1/1961 n n
10/2/1961 n n
(etc.)
And so on for each month (October thru September).
This is what I have so far (I'm fairly new at VBA so don't cringe):
Sub getmonths()
Sheets("UserInput").Activate
Dim monthpassby(12) as Double ' ungaged flow
Dim monthwithdrawal(12) as Double ' permitted withdrawal and passby
Dim months As Variant
' need code to read-in data?
'check for month in the date
Sheets("October").Range("A3").Select
Do Until IsEmpty (Sheets("UserInput").Range("C24").Value)
months = Month(Sheets("UserInput").Range("A24").Value)
Sheets("October").Range("A3").Value = monthpassby (months)
ActiveCell.Offset(0,1) = monthwithdrawal (months)
ActiveCell.Offset (1,0).Select
Loop
End Sub
I've spent about a week researching this problem. I really need help just filling the in-betweens. I've also tried using Advanced_Filter and recording my macro. A pivot table was considered, however I need the "Ungaged Flow" and "Permitted Withdrawal and Passby" data on each sheet for the individual months to calculate two more columns ("Exceedence Value" and "Streamflow") which will also be on the individual month sheets. Then I have to produce a flow duration curve for each month on the corresponding month sheets. I haven't used pivot tables to that extent, but if you know a way I can do that with a pivot table that would be awesome. And also, this will eventually be a User Input tool so the "Ungaged Flow" and "Permitted Withdrawl and Passby" values will be dependent on what values the user has.
回答1:
This is an example based on your initial code:
Option Explicit
Sub GetMonths()
Dim monthpassby(12) As Double
Dim monthwithdrawal(12) As Double
Dim currentMonth As Variant
Dim wsUserInput As Worksheet
Dim wsOctober As Worksheet
Dim i As Long, totalRows As Long
Set wsUserInput = Worksheets("UserInput")
Set wsOctober = Worksheets("October")
totalRows = wsUserInput.UsedRange.Rows.Count
For i = 24 To totalRows 'iterate through each row on sheet UserInput
currentMonth = Month(wsUserInput.Range("A" & i).Value2)
'copy array values to sheet October, column A and B, starting at row 3
With wsOctober.Range("A" & (i - 21))
.Value2 = monthpassby(currentMonth) 'Column A
.Offset(0, 1).Value2 = monthwithdrawal(months) 'Column B
End With
Next
End Sub
.
It will probably not accomplish the task, but it can be fixed if you confirm what I understand:
On sheet UserInput you have data similar to this:
Column A Column C Column I
Row 24: 10/1/1959 ungaged1 permitted1
Row 25: 10/2/1959 ungaged2 permitted2
Row 26: 10/3/1959 ungaged3 permitted3
...
...
Row N: 12/31/2013 ungagedN permittedN
The code should copy:
- "ungaged2" and "permitted2" to Sheet "February", row 25
- "ungaged3" and "permitted3" to Sheet "March", row 26
If so, then are the columns "ungaged flow" and "permitted withdrawal and passby" named spelled exactly the same on all of the "months" sheets?
回答2:
With no sample data, some of this is a bit of a guess.
Sub xfer_monthly_data()
Dim iMON As Long, lc As Long, nrw As Long, ws As Worksheet
Dim c1 As Long, c2 As Long
With Sheets("UserInput")
If .AutoFilterMode Then .AutoFilterMode = False
.Columns(1).Insert
With .Range(.Cells(23, 1), .Cells(24, 2).End(xlDown))
With .Offset(1, 0).Resize(.Rows.Count - 1, 1)
.FormulaR1C1 = "=MONTH(RC2)"
End With
With .Resize(.Rows.Count, 10)
For iMON = 1 To 12
.AutoFilter field:=1, Criteria1:=iMON
If CBool(Application.Subtotal(102, .Columns(2))) Then
Set ws = Worksheets(UCase(Format(DateSerial(2015, iMON, 1), "mmmm")))
c1 = Application.Match("ungaged flow", ws.Rows(1), 0)
c2 = Application.Match("permitted withdrawal and passby", ws.Rows(1), 0)
nrw = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Offset(1, 1).Resize(.Rows.Count - 1, 1).Copy _
Destination:=ws.Cells(nrw, 1)
.Offset(1, 3).Resize(.Rows.Count - 1, 1).Copy _
Destination:=ws.Cells(nrw, c1)
.Offset(1, 9).Resize(.Rows.Count - 1, 1).Copy _
Destination:=ws.Cells(nrw, c2)
End If
.AutoFilter field:=1
Next iMON
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
.Columns(1).Delete
End With
End Sub
Inserting a new column to be used as a 'helper' with a formula that determines the numerical month of the dates from the original column A allows a filter to be easily applied. Bulk copying operations of the visible cells are always faster than looping through individual cells and determining their validity. The helper column is removed after the operation has been completed.
This could be speeded up further by turning off screen updating, calculation and events (at a minimum).
来源：https://stackoverflow.com/questions/31280168/vba-macro-that-filters-by-month-pastes-data-for-that-month-only-on-different-sh