按月过滤的VBAmacros，仅在不同的工作表上粘贴当月的数据
我有一个工作表（名为“UserInput”），数据从1959年至2013年（从10/1/1959开始）
即：
"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 我需要写一个从A24开始的过滤macros，然后把date，每天的'ungaged flow'（从C24开始）和'允许撤销并通过'（从I24开始）值粘贴到相应的表单中（I有单独的名单“十月”，“十一月”，“十二月”等与“非stream量”和“允许撤回和通过”列）
即：
"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 nn 10/2/1960 nn ... ... 10/1/1961 nn 10/2/1961 nn (etc.)
依此类推（10月至9月）。
这是我到目前为止（我在VBA相当新，所以不要畏缩）：
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
我花了大约一个星期来研究这个问题。 我真的需要帮助，只是填补中间人。 我也尝试使用Advanced_Filter和录制我的macros。 一个数据透视表被考虑，但是我需要在每个表格上的“Ungaged Flow”和“Permitted Withdrawal and Passby”数据来计算另外两个列（“Exceedence Value”和“Streamflow”）个人月份表。 然后，我必须在相应的月份表上为每个月产生一个stream量持续时间曲线。 我还没有使用数据透视表的程度，但如果你知道一个方法，我可以做一个数据透视表，这将是可怕的。 而且，这最终将成为一个用户input工具，所以“Ungagedstream”和“允许撤销和通过”值将取决于用户具有的值。
这是一个基于你的初始代码的例子：
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
。
它可能不会完成任务，但是如果您确认了我的理解，则可以修复：
在工作表UserInput上你有类似这样的数据：
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
代码应该复制：
- “ungaged2”和“permitted2”到工作表“February”，第25行
- “ungaged3”和“permitted3”到表格“March”，第26行
如果是这样，那么在所有的“月份”表上，名称拼写完全相同吗？
没有样本数据，其中一些是有点猜测的。
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
插入一个新的列作为'辅助'用一个公式，确定从原始列Adate的数字月份允许一个filter可以很容易地应用。 可见单元的批量复制操作总是比循环单个单元并确定它们的有效性要快。 操作完成后，辅助列将被删除。
这可以通过closures屏幕更新，计算和事件（至less）来进一步加快。