Excel VBAで、重複カットする処理を作りたいです。以下仕様にて作成したいと思っているのですが、どのようなVBAにすればよいかを教えてください。

画像

Excel73閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

1

1人がナイス!しています

ThanksImg質問者からのお礼コメント

シンプルでわかりやすいご回答をありがとうございました。無事にできました。ありがとうございました。

お礼日時:8/1 19:50

その他の回答(1件)

1

※M列を作業列として使用します。 作業列に出力される値 「F列値が重複している、且つ J列値が2」の条件を満たした行 → 1 上の条件を満たさない → "A" 作業列を基準にデータを並び替え 作業列に数値(1)を返している行を削除します。 Sub test02() Dim dic As Object Dim rng As Range Dim x, w Dim n As Long Dim flg As Boolean Set dic = CreateObject("Scripting.Dictionary") With Range(Cells(Rows.Count, 1).End(xlUp), "L2") x = .Value Set rng = .Cells End With ReDim w(1 To UBound(x), 0) 'F列値をキーにして件数を格納 For n = 1 To UBound(x) dic(x(n, 6)) = dic(x(n, 6)) + 1 Next n For n = 1 To UBound(x) flg = dic(x(n, 6)) > 1 And x(n, 10) = 2 '判定結果を格納 w(n, 0) = IIf(flg = True, 1, "A") Next n 'wに数値が格納されている If Application.Sum(w) > 0 Then Application.ScreenUpdating = False '作業列に出力 rng.Columns(1).Offset(, 12).Value = w '並び替え rng.Resize(, 13).Sort key1:=rng.Columns(13), _ order1:=xlDescending, Header:=xlNo '作業列に数値を返している行を削除 rng.Columns(13).SpecialCells( _ xlCellTypeConstants, xlNumbers).EntireRow.Delete '作業列をクリア rng.Columns(13).Clear Application.ScreenUpdating = True End If End Sub

1人がナイス!しています