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过滤的宏，然后粘贴日期，'ungaged flow'（从C24开始）和'允许撤回和passby'（从I24开始）值每天到相应的表格（我有单独的表格，名为“OCTOBER”，“NOVEMBER”，“DECEMBER”等，带有“非流动”和“允许退出和通过”栏目）

即：

                               "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并录制我的宏。考虑了一个数据透视表，但是我需要在每个工作表的“Ungaged Flow”和“Permitted Withdrawal and Passby”数据中计算两个以上的列（“Exceedence Value”和“Streamflow”），这些列也将在个月月份表。然后我必须在相应的月份表上为每个月生成流量持续时间曲线。我没有在那个范围内使用数据透视表，但如果你知道一种方法，我可以使用一个非常棒的数据透视表。而且，这最终将是一个用户输入工具，因此“Ungaged Flow”和“Permitted Withdrawl and Passby”值将取决于用户拥有的值。

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

代码应该复制：

“ungaged2”和“allowed2”到Sheet“February”，第25行
“ungaged3”和“allowed3”到Sheet“March”，第26行

如果是这样，那么在所有“月份”表格中，“无管理流程”和“允许撤回和通过”列的拼写完全相同吗？

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

2 个答案: