Excel 2007 VBA基于文本过滤器复制行x次

我是VBA和can的新手；我不知道最有效的方法是什么——我要寻找的是一种根据频率将数据复制到活动单元格下方的行中的方法

示例数据如下所示：

Name     Value  Frequency   Date
Steve    10     Annual      01/03/2012 
Dave     25     Quarterly   01/03/2012 
Sarah    10     Monthly     01/03/2012 
Gavin    27     Quarterly   01/04/2012

在这种情况下，我要做的是Sarah以一个月的增量添加所有行，直到2013年3月。这意味着从2012年4月到2013年3月，在名称、值和频率保持不变的情况下，添加12行

对于史蒂夫，我想在2013年3月增加一行 对于Dave，我想添加三行（每三个月一行）

如果第一个日期改为2012年4月1日，则频率为每年一次。我不想补充任何内容，因为2013年3月之前没有其他日期

对于上述示例，输出为：

Name    Value   Frequency   Date
Steve   10  Annual      01/03/2012
Steve   10  Annual      01/03/2013
Dave    25  Quarterly   01/03/2012
Dave    25  Quarterly   01/07/2012
Dave    25  Quarterly   01/11/2012
Dave    25  Quarterly   01/03/2013
Sarah   10  Monthly     01/03/2012
Sarah   10  Monthly     01/04/2012
Sarah   10  Monthly     01/05/2012
Sarah   10  Monthly     01/06/2012
Sarah   10  Monthly     01/07/2012
Sarah   10  Monthly     01/08/2012
Sarah   10  Monthly     01/09/2012
Sarah   10  Monthly     01/10/2012
Sarah   10  Monthly     01/11/2012
Sarah   10  Monthly     01/12/2012
Sarah   10  Monthly     01/01/2013
Sarah   10  Monthly     01/02/2013
Sarah   10  Monthly     01/03/2013
Gavin   27  Quarterly       01/04/2012
Gavin   27  Quarterly       01/08/2012
Gavin   27  Quarterly       01/12/2012

---

提前谢谢

您需要一个将频率文本转换为月份数的函数（我们称之为MonthFreq，返回整数）

这将满足您的要求：

MaxDate = DateSerial(2013, 4, 1)
Do Until Origin.Cells(OriginRow, NameColumn).Value = ""
    SourceDate = Origin.Cells(OriginRow, DateColumn).Value
    Do Until SourceDate >= MaxDate
        ' Copy origin row to destiny.
        Destiny.Cells(DestinyRow, DateColumn).Value = SourceDate

        SourceDate = DateAdd("m", MonthFreq(Origin.Cells(OriginRow, FreqColumn).Value), SourceDate)
        DestinyRow = DestinyRow + 1
    Loop
    OriginRow = OriginRow + 1
Loop

Origin是包含原始数据的工作表，Destiny是保存扩展数据的工作表。OriginRow是原始工作表中正在分析的当前行（从第一行开始）。OriginColumn是正在Destiny工作表中写入的当前行（从第一行开始）。SourceDate将被添加若干个月，直到达到MaxDate。

Davin

威廉问了一个合理的问题。我仍在继续，并假设通过说“季度”，您只想增加4个月

我还假设（我想我在这一点上是正确的）您希望继续增加日期，直到日期小于2013年3月1日（无论是年度、季度还是月度，事实上都无关紧要）

请尝试此代码。我相信它可以做得更完美

经过尝试和测试

Option Explicit

Sub Sample()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim i As Long, j As Long, LastRow As Long
    Dim boolOnce As Boolean
    Dim dt As Date

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    '~~> Input Sheet
    Set ws = Sheets("Sheet1")
    '~~> Output Sheet
    Set ws1 = Sheets("Sheet2")
    ws1.Cells.ClearContents

    '~~> Get the last Row from input sheet
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    boolOnce = True

    '~~> Loop through cells in Col A in input sheet
    For i = 2 To LastRow
        j = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1

        Select Case UCase(ws.Range("C" & i).Value)
            Case "ANNUAL"
                dt = DateAdd("yyyy", 1, ws.Range("D" & i).Value)
                '~~> Check if the date is less than 1st march 2013
                If dt <= #3/1/2013# Then
                    ws1.Range("A" & j & ":A" & j + 1).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j & ":B" & j + 1).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j & ":C" & j + 1).Value = ws.Range("C" & i).Value
                    ws1.Range("D" & j).Value = ws.Range("D" & j).Value
                    ws1.Range("D" & j + 1).Value = DateAdd("yyyy", 1, ws.Range("D" & i).Value)
                End If
            Case "QUARTERLY"
                dt = DateAdd("M", 4, ws.Range("D" & i).Value)
                Do While dt <= #3/1/2013#
                    ws1.Range("A" & j).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j).Value = ws.Range("C" & i).Value
                    If boolOnce = True Then
                        ws1.Range("D" & j).Value = DateAdd("M", -4, dt)
                        boolOnce = False
                    Else
                        ws1.Range("D" & j).Value = dt
                    End If
                    dt = DateAdd("M", 4, ws1.Range("D" & j).Value)
                    j = j + 1
                Loop
                boolOnce = True
            Case "MONTHLY"
                dt = DateAdd("M", 1, ws.Range("D" & i).Value)
                Do While dt <= #3/1/2013#
                    ws1.Range("A" & j).Value = ws.Range("A" & i).Value
                    ws1.Range("B" & j).Value = ws.Range("B" & i).Value
                    ws1.Range("C" & j).Value = ws.Range("C" & i).Value
                    If boolOnce = True Then
                        ws1.Range("D" & j).Value = DateAdd("M", -1, dt)
                        boolOnce = False
                    Else
                        ws1.Range("D" & j).Value = dt
                    End If
                    dt = DateAdd("M", 1, ws1.Range("D" & j).Value)
                    j = j + 1
                Loop
                boolOnce = True
        End Select
    Next i

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

选项显式
子样本（）
将ws设置为工作表，将ws1设置为工作表
我长，j长，最后一排长
模糊布尔
Dim dt作为日期
关于错误转到哇
Application.ScreenUpdating=False
“~~>输入表
设置ws=图纸（“图纸1”）
'~~>输出表
设置ws1=图纸（“图纸2”）
ws1.Cells.ClearContents
“~~>从输入表中获取最后一行
LastRow=ws.Range（“A”&ws.Rows.Count）.End（xlUp）.Row
boolOnce=True
“~~>在输入表中A栏的单元格中循环
对于i=2到最后一行
j=ws1.Range（“A”&ws1.Rows.Count）。End（xlUp）。Row+1
选择Case UCase（ws.Range（“C”）和i.Value）
案件“年度”
dt=DateAdd（“yyyy”，1，ws.Range（“D”和i）.Value）
“~~>检查日期是否小于2013年3月1日
如果dt不是每三个月发布一次？这对我来说就像一场噩梦，你需要的代码并不难，但是。。。。可读性、实用性、布局和维护都有问题。考虑改变你的设计，也许扩展到多张纸上，并在另一张表上使用一个原始数据和演示表。@威廉-绝对（在漫长的一天结束时写下）。我们在底部看到的数据是什么？感谢这一点——季度价值对我来说是一个错误，但我认为考虑到结构，它不应该太难处理！我已经测试过了，它确实有效，我只需要找出它是如何发挥魔力的！：）是否可以询问如何使用此功能同时/而不是仅对最后一行数据执行此操作并粘贴在下面（因此根据示例，使用A5作为活动单元格，并超过A6和A7中的2行）？谢谢Davin，这是我在单元格中循环的地方“对于I=2到LastRow”，你可以将它设置为A5。我使用ws1作为输出的第二页。您可以将其定向到当前工作表：）很抱歉不知道，但是如果我希望A5成为活动单元格，而不是特定的引用，并将行粘贴到下面（因此每次只使用一个案例），我将如何修改“for I=2 to lastrow”位？谢谢：）我可以给你答案，但我希望你首先理解代码：）。“For i=2 to lastrow”循环从单元格A2到A（lastrow）。所以，如果我只想与A5互动，那么我们应该怎么做？我们应该如何编写它，使其只处理单元格A5？谢谢-请原谅我的无知，但请说我的原始单元格只是活动单元格，我想将数据粘贴到它正下方的行中-例如，如果活动单元格为A10，则以Dave（季刊）为例，我想在下面再粘贴三行数据？不要丢失输入数据。以后可能更难纠正。输出工作表仍将包含原始数据。