求助高手！！！2012-06-09

Excel中有无数行如下：

aa 25 65
aa 55 36
bb 14 11
cc 26 87
dd 14 58
dd 44 52
dd 44 35
ee 13 18
ee 22 18
ee 13 21
ee 12 18
。
。
。
。
其中第一列名字相同的行数不一定，现在需要名字相同的第一行提取出来，变成如下文本
aa 25 65
bb 14 11
cc 26 87
dd 14 58
ee 13 18
。
。
。

请高人帮忙本人QQ:13702406 --------------------编程问答-------------------- 如果是在sql中可以用临时表实现你需要程序实现吗 --------------------编程问答--------------------

引用楼主的回复:

Excel中有无数行如下：

aa 25 65
aa 55 36
bb 14 11
cc 26 87
dd 14 58
dd 44 52
dd 44 35
ee 13 18
ee 22 18
ee 13 21
ee 12 18
。
。
。
。
其中第一列名字相同的行数不一定，现在需要名字相同的第一行提取出来，变成如下文本
aa 25 65
bb 14 11
……

Sub Pick()

    Dim d As Object

    Dim S1 As Worksheet, S2 As Worksheet

    Dim TotalRow As Long, CurRow As Long

    Set d = CreateObject("Scripting.Dictionary")

    Set S1 = Sheets(1)

    Set S2 = Sheets(2)

    TotalRow = S1.[A65535].End(xlUp).Row

    For CurRow = 1 To TotalRow

        If d.exists(S1.Cells(CurRow, 1).Value) = False Then

            d(S1.Cells(CurRow, 1).Value) = CurRow

        End If

    Next CurRow

    Dim i As Long

    i = 1

    For Each dkey In d.keys

        S2.Cells(i, 1) = S1.Cells(d(dkey), 1)

        S2.Cells(i, 2) = S1.Cells(d(dkey), 2)

        S2.Cells(i, 3) = S1.Cells(d(dkey), 3)

        i = i + 1

    Next dkey

End Sub

--------------------编程问答--------------------

Option Explicit
Option Base 1
Sub test()
    Dim i%, j%, d As Object, arr, brr, t
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    arr = [a1].CurrentRegion
    For i = 1 To UBound(arr)
        If Not d.exists(arr(i, 1)) Then
            d(arr(i, 1)) = arr(i, 2) & "|" & arr(i, 3)
        End If
    Next
    With Sheet2
        .Cells.ClearContents
        .[a1].Resize(d.Count, 1) = Application.Transpose(d.keys)
        brr = .Range("a1:c" & .[a65530].End(3).Row).Value
        For i = 1 To UBound(brr)
            t = Split(d(brr(i, 1)), "|")
            For j = 0 To UBound(t)
                brr(i, j + 2) = t(j)
            Next
        Next
        .Range("a1:c" & .[a65530].End(3).Row) = brr
    End With
    Application.ScreenUpdating = True
End Sub
--------------------编程问答-------------------- Option Explicit
Option Base 1
Sub test()
    Dim i%, j%, d As Object, arr, brr, t
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    arr = [a1].CurrentRegion
    For i = 1 To UBound(arr)
        If Not d.exists(arr(i, 1)) Then
            d(arr(i, 1)) = arr(i, 2) & "|" & arr(i, 3)
        End If
    Next
    With Sheet2
        .Cells.ClearContents
        .[a1].Resize(d.Count, 1) = Application.Transpose(d.keys)
        brr = .Range("a1:c" & .[a65530].End(3).Row).Value
        For i = 1 To UBound(brr)
            t = Split(d(brr(i, 1)), "|")
            For j = 0 To UBound(t)
                brr(i, j + 2) = t(j)
            Next
        Next
        .Range("a1:c" & .[a65530].End(3).Row) = brr
    End With
    Application.ScreenUpdating = True
End Sub
--------------------编程问答-------------------- 楼主发了问题后还来过？

补充：VB ,  VBA