VBAソート - 6列のコードを展開する

Question

誰かが私が6列で動作するように次のコードを拡張するのを助けることができるのだろうかと思っていました。任意の数の行に対してはすでにうまく機能しています。列に同じ構文を追加するにはどうすればよいですか？ Username：assyliasはこのコードを構築しました。私はそれを私のソートニーズに適応させようとしています。

問題： は、私はそれは次のようにソートされる必要があり、この

X A 3 
X B 7 
X C 2 
X D 4 
Y E 8 
Y A 9 
Y B 11 
Y F 2 

のようなものをソートする必要があります：XとYである列がグループを表します。文字：A、B、C、D、E、Fはグループのメンバーを表します。数値は、我々が比較しているいくつかの指標です。その番号を獲得した最も高い数字と関連するメンバーがそのグループの「リーダー」であり、各グループの各リーダーが次のようにそのグループの各メンバーと比較されるようにデータを並べ替える：

X B A 3 
X B C 2 
X B D 4 
Y B E 8 
Y B A 9 
Y B F 2 

説明：Bは両方のグループのリーダーであることがあります。私は彼を他のすべてのメンバーと自分のセルの右に比較し、彼らが得た数字を示すコラムを持っていなければなりません。

問題：Assyliasのコードを装備しましたが、これを私のデータセットに展開しようとしています。私のデータセットには6つの列がありますので、各メンバー（State、ID＃など）を記述する定性的な列がたくさんあり、これを取り囲むようにコードを拡張する必要があります。また、どういうことかというと、いくつかのステップの説明（コメントの形式）があれば、私はドットを真につなげることができます。 （主に、私は...何dict1/dict2であり、彼らが正確にやっているのを理解していない（dict1.exists（データ（I、1））は、例えば、私には明らかにされていません。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
doIt 
End Sub 
Public Sub doIt() 

Dim data As Variant 
Dim result As Variant 
Dim i As Long 
Dim j As Long 
Dim dict1 As Variant 
Dim dict2 As Variant 

Set dict1 = CreateObject("Scripting.Dictionary") 
Set dict2 = CreateObject("Scripting.Dictionary") 
data = Sheets("Sheet1").UsedRange 

For i = LBound(data, 1) To UBound(data, 1) 
    If dict1.exists(data(i, 1)) Then 
     If dict2(data(i, 1)) < data(i, 3) Then 
      dict1(data(i, 1)) = data(i, 2) 
      dict2(data(i, 1)) = data(i, 3) 
     End If 
    Else 
     dict1(data(i, 1)) = data(i, 2) 
     dict2(data(i, 1)) = data(i, 3) 
    End If 
Next i 

ReDim result(LBound(data, 1) To UBound(data, 1) - dict1.Count, 1 To 4) As Variant 

j = 1 
For i = LBound(data, 1) To UBound(data, 1) 
    If data(i, 2) <> dict1(data(i, 1)) Then 
     result(j, 1) = data(i, 1) 
     result(j, 2) = dict1(data(i, 1)) 
     result(j, 3) = data(i, 2) 
     result(j, 4) = data(i, 3) 
     j = j + 1 
    End If 
Next i 

With Sheets("Sheet2") 
    .Cells(1, 5).Resize(UBound(result, 1), UBound(result, 2)) = result 
End With 

終了サブ

Answer 1

私は、コードをコメントし、6列を得るためにそれを修正してきた。今では迅速なショットで、それはおそらく、最適化、向上させることができるなど

Public Sub doIt() 

    Dim inputData As Variant 
    Dim result As Variant 
    Dim thisGroup As String 
    Dim thisMember As String 
    Dim thisScore As String 
    Dim i As Long 
    Dim j As Long 
    Dim membersWithHighestScore As Variant 'Will store the member with highest score for each group 
    Dim highestScore As Variant 'Will store the highest score for each group 

    Set membersWithHighestScore = CreateObject("Scripting.Dictionary") 
    Set highestScore = CreateObject("Scripting.Dictionary") 
    inputData = Sheets("Sheet1").UsedRange 

    'First step: populate the dictionaries 
    'At the end of the loop: 
    ' - membersWithHigestScore will contain the member with the highest score for each group, for example: X=B, Y=B, ... 
    ' - highestScore will contain for example: X=7, Y=11, ... 
    For i = LBound(inputData, 1) To UBound(inputData, 1) 
     thisGroup = inputData(i, 1) 'The group for that line (X, Y...) 
     thisMember = inputData(i, 2) 'The member for that line (A, B...) 
     thisScore = inputData(i, 3) 'The score for that line 
     If membersWithHighestScore.exists(thisGroup) Then 'If there already is a member with a high score in that group 
      If highestScore(thisGroup) < thisScore Then 'if this new line has a higher score 
       membersWithHighestScore(thisGroup) = thisMember 'Replace the member with highest score for that group with the current line 
       highestScore(thisGroup) = thisScore 'This is the new highest score for that group 
      End If 'If the line is not a new high score, skip it 
     Else 'First time we find a member of that group, it is by definition the highest score so far 
      membersWithHighestScore(thisGroup) = thisMember 
      highestScore(thisGroup) = thisScore 
     End If 
    Next i 

    ReDim result(LBound(inputData, 1) To UBound(inputData, 1) - membersWithHighestScore.Count, 1 To 7) As Variant 

    j = 1 
    For i = LBound(inputData, 1) To UBound(inputData, 1) 
     thisGroup = inputData(i, 1) 'The group for that line (X, Y...) 
     thisMember = inputData(i, 2) 'The member for that line (A, B...) 
     If thisMember <> membersWithHighestScore(thisGroup) Then 'If this is a line containing the highest score for that group, skip it 
      result(j, 1) = thisGroup 
      result(j, 2) = membersWithHighestScore(thisGroup) 
      'Copy the rest of the data as is 
      result(j, 3) = inputData(i, 2) 
      result(j, 4) = inputData(i, 3) 
      result(j, 5) = inputData(i, 4) 
      result(j, 6) = inputData(i, 5) 
      result(j, 7) = inputData(i, 6) 
      j = j + 1 
     End If 
    Next i 

    With Sheets("Sheet2") 
     .Cells(1, 5).Resize(UBound(result, 1), UBound(result, 2)) = result 
    End With 

End Sub