（excel）値が連続していた場合、削除してしまうマクロ

質問

ある列で、値（文字）が連続していた場合、
一番上の行のみ残し、他の行を削除
そして、番号を*-*と合体させたいのですが、、、
マクロをつかわなきゃいけないと思うんですけど
勉強中でなかなか完成できません！
どなたかレクチャーお願いします！

（例）
1　りんご
2　りんご
3　みかん
4　みかん
5　みかん
6　もも
7　もも

　↓

1-2　りんご
3-5　みかん
6-7　もも

回答No.1

jindon · ベストアンサー

番号が A1から、
項目が B1からということで

Sub test()
Dim i As Long, ii As Long, x
With ActiveSheet
i = 1
Do Until IsEmpty(.Cells(i, 2))
For ii = i + 1 To .Range("a65536").End(xlUp).Row
If .Cells(ii, 2) = .Cells(i, 2) Then
x = .Cells(ii, 1).Value
.Rows(ii).Delete
ii = ii - 1
Else
If x <> 0 Then
x = .Cells(i, 1) & "-" & x
With .Cells(i, 1)
.NumberFormat = "@"
.HorizontalAlignment = xlRight
.Value = x
End With
x = 0
End If
Exit For
End If
Next
i = ii
Loop
End With
End Sub

お礼

ありがとうございます！
見事にやりたいことが実行できました！
。。。項目をC列も一緒に消してしまうにはどうしたらいいですか？

回答No.7

jindon

jindonです

#1で提示したコードがそのものズバリだとおもうのですが？

B列の１行目からその１行下の値を比較して、同じであれば下の方の行全体を削除しますが、
基の行はそのままで変わるのはA列だけです。

もう一度最初のコードを実行してみてください。

お礼

本当に申し訳ございません！
私のはやとちりなだけでそのとおりでした！
ありがとうございます。

回答No.6

tarame

#3です
何度も申し訳けありません。
COUNTIF(B$2:B$8,F2)
括弧が多かったようです

お礼

成功しました！
はじめは、意味が良く分からなかったのですが、
INDEX と MATCHの組み合わせとか、なるほどなぁ～と感心してしまいました。
ありがとうございます！

回答No.5

jindon

>C列の値は一番上の値だけ残して消すことがしたかったのです。

具体的に例題で示してください。

お礼

ありがとうございます。
（例）
1　りんご　愛知
2　りんご　奈良
3　みかん　東京
4　みかん　奈良
5　みかん　大阪
6　もも　　大阪
7　もも　　奈良

　↓

1-2　りんご　愛知
3-5　みかん　東京
6-7　もも　　大阪

といった感じに。
同じかどうか調べるのはB列
A列は合体させる。C列はB列の値の一番上の物だけのこして消去。といった感じです。

回答No.4

jindon

jindonです

残った行のC列の値を消すということでしたら、

Sub test()
Dim i As Long, ii As Long, x
With ActiveSheet
i = 1
Do Until IsEmpty(.Cells(i, 2))
For ii = i + 1 To .Range("a65536").End(xlUp).Row
If .Cells(ii, 2) = .Cells(i, 2) Then
x = .Cells(ii, 1).Value
.Rows(ii).Delete
ii = ii - 1
Else
.Cells(ii, 3).Value = ""
If x <> 0 Then
x = "'" & .Cells(i, 1) & "-" & x
With .Cells(i, 1)
.HorizontalAlignment = xlRight
.Value = x
.Offset(, 2).Value = ""
End With
x = 0
End If
Exit For
End If
Next
i = ii
Loop
End With
End Sub

でしょうか？

お礼

さっそくの解答、ありがとうございます！
しかし、質問の仕方がかなり悪かったです！ごめんなさい。
C列の値は一番上の値だけ残して消すことがしたかったのです。

回答No.3

tarame

#2です。タイプミスでした。

[C2] =IF(B2=B1,C1,C1+1)
-------------**-**----
[E2] =IF(E1<MAX(C$2:C$8),E1+1,"")
[F3] =IF(E2="","",INDEX(A$2:C$8,MATCH(E2,C$2:C$8),2))
------------------------*--------------
[G2] =IF(E2="","",G1+COUNTIF(B$2:B$8),F2))
[H2] =IF(E2="","",(G1+1)&"-"&G2)

*のところ直しました。大変申し訳ありませんでした

お礼

なんとなく、やり方が見えてきたのですが
やはりエラーがでてしまいます。
[G2] で引数が足りないといあれてしまいます。
なぜでしょう？

回答No.2

tarame

マクロを使わなくても、出来ますよ。
[ A ][ B ]　　　
[1] 番　　値　　
[2]　1　りんご
[3]　2　りんご
[4]　3　みかん
[5]　4　みかん
[6]　5　みかん
[7]　6　もも
[8]　7　もも

２行目のセルに、次のように入力します。
[C2] =IF(B2=B1,C2,C2+1)
[E2] =IF(E1<MAX(C$2:C$8),E1+1,"")
[F3] =IF(E2="","",INDEX(A$2:A$8,MATCH(E2,C$2:C$8),2))
[G2] =IF(E2="","",G1+COUNTIF(B$2:B$8),F2))
[H2] =IF(E2="","",(G1+1)&"-"&G2)
あとは、８行目まで「コピー」すれば、ＯＫです。

あっ！列の順序が違ってましたね！
列毎に「切り取り」→「切り取ったセルの挿入」で移動すれば、
希望通りの形になるかと思います。

お礼

返事ありがとうございます！
[C2] では循環関数と、言われてしまい
[F3] では引数が多すぎるといわれてしまい
成功しませんでした。。。