重複行の枠線内内容分のみを削除

質問

Excel2013ですがフォームがあり重複する行をExcel枠線を残しVBAコードでセル項目、数値のみ削除したいのですが
A列　B列　C列
あ　 １　　a
あ　 １　　a
あ　 ２　　a
い　 １　　a
い　 ２　　c
い　 ２　　c

A列　B列　C列
あ　 １　　a
あ　 ２　　a
い　 １　　a
い　 ２　　c
のようにABC列同一文字は１行にしExcel枠線を残すVBAコード、関数の解る方ご教授願います。
ActiveSheet.Range("$A$1:$C$6").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
上記の以前回答頂いたVBAコードで内容は問題なかったのですが枠線まで削除されるので改めて枠線を作っていますどうかよろしくお願いします。

回答No.2

kkkkkm · ベストアンサー

> でも今回のはやはり別シートを作らなければいけないですよね。

RemoveDuplicatesを使う場合だと別シートか既存のシートの利用しないところで一時的に作業をしないとダメっぽいですね。

RemoveDuplicatesを使わない方法だと
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_jyufuku.html
上記のページで紹介されている一番最後の「Dictionaryを利用する」を基にしてA,B,Cの3列をカンマ区切りの文字列として結合し、Dictionaryに登録後にSplit関数で3つにわける方法でも。(No1の時には時間がなかったので簡単な方法のみ紹介しました)
以下のような感じで

Dim myDic As Object, myKey As Variant
Dim c As Variant, varData() As String, rdData As Variant
Dim i As Long, j As Long

Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("Sheet2")
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
ReDim Preserve varData(i)
varData(i) = .Cells(i, "A") & "," & .Cells(i, "B") & "," & .Cells(i, "C")
Next i
For Each c In varData
If Not c = Empty Then
If Not myDic.Exists(c) Then
myDic.Add c, Null
End If
End If
Next
myKey = myDic.Keys
.Range("A:C").ClearContents
For i = LBound(myKey) To UBound(myKey)
rdData = Split(myKey(i), ",")
For j = LBound(rdData) To UBound(rdData)
.Cells(i + 1, j + 1) = rdData(j)
Next j
Next i
End With
Set myDic = Nothing

お礼

ありがとうございます。完璧で非常に助かりました。

回答No.1

kkkkkm

tempというシートを作成して

ActiveSheet.Range("$A$1:$C$6").Copy Sheets("temp").Range("A1")
Sheets("temp").Range("$A$1:$C$6").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
ActiveSheet.Range("$A$1:$C$6").ClearContents
Sheets("temp").Range("$A$1:$C$6").Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("temp").Range("$A$1:$C$6").Clear

このようなのはいかがですか。

補足

ありがとうございます。ほんとに助かっています。ちょっとの応用で問題なく対応できました。でも今回のはやはり別シートを作らなければいけないですよね。