0

我是一个新手，但对 Excel VBA 可以做什么很着迷！我需要帮助创建一个将每个符号的前三个日期复制并粘贴到新工作表（Sheet2）的宏。

以下是我拥有的数据（Sheet1）...

A       8/17/2013
A       9/21/2013
A      11/16/2013
A       1/18/2014
A       2/22/2014
A       1/17/2015
AA       8/9/2013
AA      8/17/2013
AA      9/21/2013
AA     10/19/2013
AA      1/18/2014
AA      1/17/2015
AAN     8/17/2013
AAN     9/21/2013
AAN    11/16/2013
AAN     2/22/2014
AAP     8/17/2013
AAP     9/21/2013
AAP    12/21/2013
AAP     1/18/2014
AAP     3/22/2014
AAP     1/17/2015
AAPL     8/9/2013
AAPL    8/17/2013
AAPL    8/23/2013
AAPL    8/30/2013
AAPL     9/6/2013
AAPL    9/21/2013
AAPL   10/19/2013
AAPL   11/16/2013
AAPL    1/18/2014
AAPL    4/19/2014
AAPL    1/17/2015
AAWW    8/17/2013
AAWW    9/21/2013
AAWW   11/16/2013
AAWW    2/22/2014

问题是我不想要 Sheet1 中的所有符号。我在 Sheet2 中有我想要的特定符号。此外，在 sheet2 中，我已经为每个符号设置了三行，其中复制并粘贴了符号名称。

所以我想要的是如果表 1 中的符号等于表 2 中的符号然后复制日期但我希望前三个日期而不是第一个日期重复 3 次..

所需的 sheet2 看起来像这样

A       8/17/2013
A       9/21/2013
A      11/16/2013
AAWW    8/17/2013
AAWW    9/21/2013
AAWW   11/16/2013

请记住，我已经有符号的左列。我需要每个符号匹配的前三个日期..

谁能帮我这个？我非常感谢任何人提前提供的帮助。

4

3 回答 3

1

使用您提供的示例数据，并假设您使用的是 Excel 2007 或更高版本，并且您的数据将第 1 行作为标题行，以便实际数据从第 2 行开始，在“Sheet2”单元格 B2 中使用此公式并向下复制（您将需要格式化为日期）：

=INDEX(Sheet1!$B$2:$B$38,MATCH(1,INDEX((Sheet1!$A$2:$A$38=A2)*(COUNTIFS(A$1:A1,A2,B$1:B1,Sheet1!$B$2:$B$38)=0),),0))

如果愿意，这是一个 VBA 解决方案：

Sub tgr()

    Dim cllSymbols As Collection
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rngSymbols As Range
    Dim SymbolCell As Range
    Dim rngFound As Range
    Dim arrData() As Variant
    Dim varSymbol As Variant
    Dim strFirst As String
    Dim DataIndex As Long
    Dim i As Long

    Set cllSymbols = New Collection
    Set wsData = Sheets("Sheet1")
    Set wsDest = Sheets("Sheet2")
    Set rngSymbols = wsDest.Range("A2", wsDest.Cells(Rows.Count, "A").End(xlUp))
    If rngSymbols.Row < 2 Then Exit Sub 'No data

    On Error Resume Next
    For Each SymbolCell In rngSymbols.Cells
        If Len(SymbolCell.Text) > 0 Then cllSymbols.Add SymbolCell, SymbolCell
    Next SymbolCell
    On Error GoTo 0

    If cllSymbols.Count > 0 Then
        ReDim arrData(1 To cllSymbols.Count * 3)
        For Each varSymbol In cllSymbols
            Set rngFound = wsData.Columns("A").Find(varSymbol, , xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                i = 0
                strFirst = rngFound.Address
                Do
                    i = i + 1
                    If i > 3 Then Exit Do
                    DataIndex = DataIndex + 1
                    arrData(DataIndex) = wsData.Cells(rngFound.Row, "B").Text
                    Set rngFound = wsData.Columns("A").Find(varSymbol, rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        Next varSymbol
        rngSymbols.Offset(, 1).Value = Application.Transpose(arrData)
    End If

    Set cllSymbols = Nothing
    Set wsData = Nothing
    Set wsDest = Nothing
    Set rngSymbols = Nothing
    Set SymbolCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub
于 2013-08-09T17:38:40.563 回答
0

公式版本...

使用 Match 查找第一个符号出现的行，并使用 index 查找数据。我假设您的符号在 A 列中，而日期在 B 列中

对于第一个日期，=INDEX(Sheet1!B:B,MATCH(A1,sheet1!A:A,0)+0,1)
对于第二个日期，从第一个匹配项向下移动 1： =INDEX(Sheet1!B:B,MATCH(A2,sheet1!A:A,0)+1,1)
并重复任意多个匹配项： 

=INDEX(Sheet1!B:B,MATCH(A3,sheet1!A:A,0)+2,1)
=INDEX(Sheet1!B:B,MATCH(A4,sheet1!A:A,0)+3,1)
=INDEX(Sheet1!B:B,MATCH(A5,sheet1!A:A,0)+4,1)

一旦你有足够的，再次从+0开始

于 2013-08-09T19:21:42.300 回答
0

完全不需要 VBA，这可以通过工作表公式轻松处理：

  =OFFSET(Sheet1!$A$1,MATCH(A1,Sheet1!$A$1:$A$37,0)-1+MOD(ROW(A1)+2,3),1,1,1)

该公式假定源数据和结果集都从各自工作表的第 1 行开始。如果结果集不是从第 1 行开始，您将需要调整MOD(ROW(A1)+2),3)公式的子句，该子句应生成系列 0、1、2、0、1 等，因为它被复制到工作表中。


在此处输入图像描述

于 2013-08-09T18:15:08.027 回答