按月過濾的VBA宏，僅將該月的數據粘貼到不同的工作表上

Question

我有一張工作表（名為“ 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開始month過濾，然后將每天的日期，“未使用流量”（從C24開始）和“允許的提現和通過”（從I24開始）值粘貼到其對應的工作表（I有單獨的工作表，分別名為“十月”，“十一月”，“十二月”等，並帶有“不良流量”和“允許的提款和通過”欄）

即：

---

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

以此類推，每個月（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並記錄我的宏。 考慮了數據透視表，但是我需要每個月的每個工作表上的“未分配流量”和“允許取款和通過”數據，以計算另外兩列（“超出值”和“流”），這些數據也將單獨的月份表。 然后，我必須在相應的月度表上生成每個月的流量持續時間曲線。 我還沒有使用過樞軸表，但是如果您知道一種可以使用樞軸表的方法，那將非常棒。 而且，這最終將成為用戶輸入工具，因此“未分配流量”和“允許的提款和通過”值將取決於用戶的值。

Answer 1

由於沒有樣本數據，因此有些猜測。

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中日期的數字月份，從而可以輕松應用過濾器。 可見單元的批量復制操作總是比循環遍歷單個單元並確定其有效性更快。 操作完成后，將刪除幫助器列。

可以通過關閉屏幕更新，計算和事件（至少）來進一步加快速度。

Answer 2

這是一個基於您的初始代碼的示例：

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

該代碼應復制：

• 工作表“二月”第25行的“ ungaged2”和“ permitted2”
• 工作表“ 3月”第26行的“ ungaged3”和“ permitted3”

如果是這樣，那么在所有“月份”工作表中，名為“未正常使用的流量”和“允許的出入和通過”列的拼寫是否完全相同？