ExcelVBAで重複しているもの以外を抜き出したい

質問

Excelで以下のようなことをしたいのです。

　　　　A
1　　みかん
2　　りんご
3　　みかん
4　　めろん
5　　りんご

とあったとします。

この表から、重複したものははぶいてカウントしたいのですが、
どのようにしたらよいでしょうか？

【理想結果】
　　　C　　　　　D
1　みかん　　　2
2　りんご　　　 2
3　めろん　　　1

実際に試してみたコードは以下の通りです。

-------ここから----------
Dim i As Integer
Dim i2 As Integer
Dim Count As Integer
Dim Name As String
Dim Last As Integer

For i = 1 To 5 'A列の1行目から5行目まで。
Last = Cells(3).CurrentRegion.Rows.Count 'C列の最終行を取得。
Name = Cells(i, 1) 'NameはA列の値。
For i2 = 1 To Last
Select Case Name
Case Is = Cells(i2, 3)
Cells(Last + 1, 3) = ""
Case Is <> Cells(i2, 3)
Cells(Last + 1, 3) = Name
End Select
Next
Next

上記コードを試すと、C列の1行目があいて2行目からA列をそのまま写した状態になってしまいます。

Ex2000です。

回答No.1

maruru01 · ベストアンサー

こんにちは。maruru01です。

いろいろ問題がありますが、このコードをそのまま変えるより、以下のコードの方がいいと思います。
ちなみに、D列の個数も付けました。

　　Dim i As Long
　　Dim j As Long
　　Dim Name As String
　　Dim Last As Long

　　Last = 0

　　For i = 1 To 5
　　　　Name = Cells(i, 1)
　　　　If Last = 0 Then
　　　　　　'最初のデータ
　　　　　　Cells(1, 3) = Name
　　　　　　Cells(1, 4) = 1
　　　　　　Last = 1
　　　　Else
　　　　　　'重複チェック
　　　　　　For j = 1 To Last
　　　　　　　　If Cells(j, 3) = Name Then
　　　　　　　　　　'見つかったらD列をインクリメント
　　　　　　　　　　Cells(j, 4) = Cells(j, 4) + 1
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next j
　　　　　　'データが見つからなかった場合
　　　　　　If j > Last Then
　　　　　　　　Last = Last + 1
　　　　　　　　Cells(Last, 3) = Name
　　　　　　　　Cells(Last, 4) = 1
　　　　　　End If
　　　　End If
　　Next i

お礼

回答ありがとうございます。

試してみたところうまくいきました。

何点か不明なところがあったので、また質問させてください。

＞ '見つかったらD列をインクリメント
＞ Cells(j, 4) = Cells(j, 4) + 1
これはどのようなことを行っているのでしょうか？

＞　　　　　If j > Last Then

C列の行数を指定するjがLastより大きかったら、ということで、
C列の一番上をあけないための方法ですよね？（最初はLast=1になってますから）

回答No.4

maruru01

再びmaruru01です。

＞＞ '見つかったらD列をインクリメント
＞＞ Cells(j, 4) = Cells(j, 4) + 1
＞これはどのようなことを行っているのでしょうか？

D列には個数を表示するんですよね。
だから、最初のデータ(A1)や、C列に見つからなかったデータは、C列に新しく行を追加して隣のD列には1を代入し、C列に見つかった場合は、見つかるたびに+1していけば個数になりますね。

＞＞　　　　　If j > Last Then
＞
＞C列の行数を指定するjがLastより大きかったら、ということで、
＞C列の一番上をあけないための方法ですよね？（最初はLast=1になってますから）

変数jは、C列の先頭から、最後の行（Last）までをループするカウンタです。
で、For～Next文の仕組みとして、
Next j
の行で、j = j + 1
とインクリメントされます。
で、そのインクリメントされた結果を元に、
For j = 開始 To 終了
の終了と比較して、終了を超えていたら、ループから抜け出します。
（終了以下なら、ループ内に入る）
したがって、For文で最後までループし終えたら（つまり途中Exit Forで抜けなかったら）、最後は、j = 終了 + 1になっているのです。
この場合、終了はLastですから、最後までループし終えたら（データが見つからなかったら）、ループ直後は、
j = Last + 1
になっています。
したがって、見つからなかった場合の条件として、
If j > Last Then
としているのです。
もちろん、これを、
If j = Last + 1 Then
としてOKなわけです。

つまりこのIf条件は重複していないデータを新たな行に書き込むための条件です。
C列の一番上を空けないためのコードは、

If Last = 0 Then
　　'最初のデータ
　　Cells(1, 3) = Name
　　Cells(1, 4) = 1
　　Last = 1

の部分です。
ここで、Last = 1
といれているので、要は一番最初のデータ（A1）の場合のみの分岐です。

お礼

再び回答ありがとうございます。

＞最初のデータ(A1)や、C列に見つからなかったデータは、C列に新しく行を追加して隣のD列には1を代入し、C列に見つかった場合は、見つかるたびに+1していけば個数になりますね。

こんなことをしていたんですね（＾＾；
1つずつ増えてくデータ、ぐらいしかわかりませんでした。

お二人とも丁寧にありがとうございました。

もう一度読み返し理解した上で、また自分でコードをかいてみます。

ありがとうございました。

回答No.3

imogasi

再度の答えで済みません。case を使うよう修正しました。
Sub test01()
k = 0
last = Range("a1").CurrentRegion.Rows.Count
MsgBox last
For i1 = 1 To last
Name = Cells(i1, 1) 'NameはA列の値。
For i2 = 1 To k
Select Case Name
Case Is = Cells(i2, 3)
Cells(i2, 4) = Cells(i2, 4) + 1
GoTo p01
Case Else
End Select
Next i2
k = k + 1
Cells(k, 3) = Name
Cells(k, 4) = 1
p01:
Next i1
End Sub
●p01:は悪名高きＧＯＴＯ文の飛び先を示すポント名です
。

お礼

再び回答ありがとうございます。

自分が書いたコードと突き合わせて見直しさせていただきますね。

＞●p01:は悪名高きＧＯＴＯ文の飛び先を示すポント名です

位置を指定できるんですか！知りませんでした。
Exitしか普段使わないので・・・。
今度機会があったら使ってみます。

ありがとうございました。

回答No.2

imogasi

Caseを使ってはいませんが極く平凡に考えました。
' Ａ列をＣ列に探す（ポインタ Ａ列i1、Ｃ列i2)
' セルＣ列に始めて見つかった果物名をｋ行にセット
'　Ａ列と同じものがＣ列にあれば件数に＋１
'
Sub test01()
k = 0
last = Range("a1").CurrentRegion.Rows.Count
For i1 = 1 To last
Name = Cells(i1, 1)
For i2 = 1 To k
If Name = Cells(i2, 3) Then
Cells(i2, 4) = Cells(i2, 4) + 1
MsgBox i1
GoTo p01
Else
End If
Next i2
k = k + 1
Cells(k, 3) = Name
Cells(k, 4) = 1
p01:
Next i1
End Sub

お礼

回答ありがとうございます。

こちらも無事できました。

質問なのですが、

＞p01:

ってどのような働きをしているのでしょうか？
初めてみたので意味不明で？？です。

よろしくお願いします。