マクロ：条件付き行の削除

Question

誰かが私にこれを手伝ってくれるかどうか疑問に思っていました。私は、次の達成するためにマクロを作成しようとしています：

I次のExcelの表があります。

Letter Number 
A  15 
A  2212 
A  3741 
B  251 
B  7 
B  14201 
C  13503 
C  97 
C  113 

は私があるたびに「文字列」を通過してしまうのマクロを構築したいと思いますが同じ文字、それの横にある "数値列"を参照し、小さな値を削除 - 最大値だけを維持。

私は以下に示すように、各文字とその隣に対応する値に対して1つだけのエントリを持っている最終的な結果を希望：

Letter Number 
A  3741 
B  14201 
C  13503 

ない、これは可能だろうか、複雑なマクロのを確認してください。先輩に感謝します。

Answer 1

あなたの手紙が列Aにあり、数字が列Bにある場合は、次のコードは、トリックを行う必要があります。

Sub FindMaxValue() 

Dim CountLng As Long 

'find range 
CountLng = ActiveSheet.UsedRange.Rows.Count 

'loop through range to find max 
For x1 = CountLng To 2 Step -1 
    For x2 = 2 To CountLng 
     If Range("A" & x1).Value = Range("A" & x2).Value And x1 <> x2 Then 
      If Range("B" & x1).Value >= Range("B" & x2).Value Then 
       Rows(x2).EntireRow.Delete 
       Exit for 
      Else 
       Rows(x1).EntireRow.Delete 
       Exit For 
      End If 
     End If 
    Next x2 
Next x1 

End Sub 

Answer 2

あなたは「低級削除するには、各文字に最大値を保持するためにDictionaryを使用し、AutoFilter()ができ"値の文字列：

Option Explicit 

Sub min() 
    Dim rng As Range, cell As Range 
    Dim key As Variant 

    Set rng = Range("B1", Cells(Rows.Count, "A").End(xlUp)) 
    With CreateObject("Scripting.Dictionary") 
     For Each cell In rng.Resize(rng.Rows.Count - 1, 1).Offset(1) 
      If .Exists(cell.value) Then 
       If cell.Offset(, 1) > .item(cell.value) Then .item(cell.value) = cell.Offset(, 1).value 
      Else 
       .Add cell.value, cell.Offset(, 1).value 
      End If 
     Next 
     Application.DisplayAlerts = False 
     For Each key In .Keys 
      rng.AutoFilter field:=1, Criteria1:=key 
      rng.AutoFilter field:=2, Criteria1:="<" & .item(key) 
      rng.Resize(rng.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete 
      rng.AutoFilter 
     Next 
     Application.DisplayAlerts = True 
    End With 
End Sub