Question

我是新手但对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中，每个符号都有三行，复制并粘贴了符号名称。

所以我想要的是如果Sheet 1中的符号等于Sheet 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

请记住，我的左栏已经包含了符号。我需要为每个符号匹配前三个日期..

任何人都可以帮我吗？我非常感谢任何人的帮助。

Answer 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

Answer 2

根本不需要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 ......等系列，因为它是复制了表格。

enter image description here

Answer 3

公式版......

使用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开始

将特定单元格值复制并粘贴到其他工作表

3 个答案: