Excel 中的排序和过滤

Question

A	列 B	列 C	列 D
John	22	David	87
Marcy	42	Kumar	23
Kumar	35	Marcy	42
David	21	John	33

在 Excel 根据 A 列对 C 列进行排序时，C 列和 D 列的数据将一起移动。

例如：第一行将是

Column A	Column B	Column C	Column D
John	22	John	33

我尝试过 Excel 函数，例如：

PROCV、VLOOKUP 以及排序和过滤按钮优秀但没有运气。

Answer 1

注意：

1. 所有行必须由 a 列中的名称唯一标识
2. 您需要引用 Microsoft Scripting Runtime

... 无论如何

Sub sheesh()

    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(1)
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    Dim i As Integer
    For i = 1 To lastRow
        dict.Add CStr(ws.Cells(i, 3).Value), CInt(ws.Cells(i, 4).Value)
    Next i
    
    For Each k In dict.Keys
        Debug.Print k
    Next
    
    For i = 1 To lastRow
        If dict.Exists(ws.Cells(i, 1).Value) Then
            ws.Cells(i, 3).Value = ws.Cells(i, 1).Value
            ws.Cells(i, 4).Value = dict(ws.Cells(i, 1).Value)
        End If
    Next i
    
End Sub

Answer 2

对齐数据

Option Explicit

Sub AlignData()
    
    Const fRow As Long = 1
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim Key As Variant
    Dim r As Long
    
    ' Left two columns to left dictionary.
    
    Dim llRow As Long: llRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim lCount As Long: lCount = llRow - fRow + 1
    Dim lrg As Range: Set lrg = ws.Cells(fRow, "A").Resize(lCount, 2)
    Dim lData As Variant: lData = lrg.Value
    Dim lDict As Object: Set lDict = CreateObject("Scripting.Dictionary")
    lDict.CompareMode = vbTextCompare
    
    For r = 1 To lCount
        Key = lData(r, 1)
        If Not IsError(Key) Then ' exclude error values
            If Len(Key) > 0 Then ' exclude blanks
                lDict(lData(r, 1)) = lDict(lData(r, 1)) + lData(r, 2) ' Sum
            End If
        End If
    Next r
    Erase lData
    lCount = lDict.Count
    
    ' Right two columns to right dictionary.
    
    Dim rlRow As Long: rlRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    Dim rCount As Long: rCount = rlRow - fRow + 1
    Dim rrg As Range: Set rrg = ws.Cells(fRow, "C").Resize(rCount, 2)
    Dim rData As Variant: rData = rrg.Value
    Dim rDict As Object: Set rDict = CreateObject("Scripting.Dictionary")
    rDict.CompareMode = vbTextCompare
    
    For r = 1 To rCount
        Key = rData(r, 1)
        If Not IsError(Key) Then ' exclude error values
            If Len(Key) > 0 Then ' exclude blanks
                rDict(rData(r, 1)) = rDict(rData(r, 1)) + rData(r, 2) ' Sum
            End If
        End If
    Next r
    Erase rData
    rCount = rDict.Count
    
    ' Write to destination arrays.
    
    ReDim lData(1 To lCount, 1 To 2) ' exact size
    ReDim rData(1 To lCount + rCount, 1 To 2) ' oversized
    r = 0
    
    For Each Key In lDict.Keys
        r = r + 1
        lData(r, 1) = Key: lData(r, 2) = lDict(Key)
        If rDict.Exists(Key) Then
            rData(r, 1) = Key: rData(r, 2) = rDict(Key)
            rDict.Remove Key
        End If
    Next Key
        
    If rDict.Count > 0 Then
        For Each Key In rDict.Keys
            r = r + 1
            rData(r, 1) = Key: rData(r, 2) = rDict(Key)
        Next Key
    End If
    
    ' Overwrite ranges.
    
    With lrg
        .Resize(lDict.Count).Value = lData
        .Resize(ws.Rows.Count - .Row - lCount + 1).Offset(lCount).ClearContents
    End With
    With rrg
        .Resize(r).Value = rData
        .Resize(ws.Rows.Count - .Row - r + 1).Offset(r).ClearContents
    End With
    
    MsgBox "Data aligned.", vbInformation
    
End Sub