按月份过滤的VBA宏，仅将该月份的数据粘贴到不同的工作表上

我有一张表（名为“UserInput”），上面有1959-2013年的数据（从1959年10月1日开始）

i、 e:

---

我需要编写一个宏，从A24开始按月份进行过滤，然后将每天的日期、“未冻结流量”（从C24开始）和“允许提取和传递”（从I24开始）值粘贴到相应的表中（我有单独的表名为“10月”、“11月”、“12月”，带有“未冻结流量”和“允许提取和通过”列）

i、 e:

---

每月（10月至9月）依此类推

这就是我到目前为止所拥有的（我在VBA是相当新的，所以不要畏缩）：

---

我已经花了大约一周的时间研究这个问题。我真的需要帮助来填充中间值。我还尝试使用

Advanced\u Filter

并记录我的宏。考虑了一个透视表，但是我需要“Ungaged Flow”和“allowed draw and Passby”各月各表上的数据，以计算另外两列（“超标值”和“流量”），这两列也将出现在各月表上。然后，我必须在相应的月表上生成每个月的流量-持续时间曲线。我还没有使用透视表到那种程度，但如果你知道一种方法，我可以用透视表做到这一点，那就太棒了。此外，这最终将成为一个用户输入工具，因此“未冻结流量”和“允许取款和通过”值将取决于用户拥有的值。

这是一个基于初始代码的示例：

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

它可能无法完成任务，但如果您确认我的理解，它可以修复：

在sheet 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

代码应复制：

• 第25行第2页“2月”中的“未登记”2和“许可证”2
• 第26行“3月”页中的“未经批准的3”和“许可的3”

---

如果是这样的话，那么在所有“月”表上命名的列“未记账流量”和“允许取款和通过”的拼写是否完全相同？

没有样本数据，有些只是猜测

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

插入一个新列用作“助手”，并使用公式确定原始列a中日期的数字月份，这样可以轻松应用过滤器。可见单元格的批量复制操作总是比在单个单元格中循环并确定其有效性更快。操作完成后，将删除“帮助器”列

---

这可以通过关闭屏幕更新、计算和事件（至少）来进一步加快速度。

实际上，当您明确引用需要处理的每张工作表时，这是非常好的！问题是您没有增加行数。我将简短地向您展示一个示例，即第一行的月度工作表中的未冻结流和允许提取和通过列标签？值的第一个空格从A3（“日期”列）、B3（“未冻结流”）和C3（“允许提取和通过”）开始抱歉，我忘了说明我的日期列的格式是mm/dd/yyyy。因此，未标记的1-3和允许的1-3都将出现在“十月”表中。如果有帮助的话，我会把我的问题再细化一点。

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

        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

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