[[20190227133724]] 『重複行を削除して該当データを,で結ぶ方法』(マクロン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『重複行を削除して該当データを,で結ぶ方法』(マクロン)

下記の様に、5列複数行にデータが入っています。

そこでコードbとコードcが同じならば

コードaの少ない行に、コードaの多い行から、
料金aと料金bを挿入(カンマでつなぐ)し、
その後、コードaの多い行を削除という様にしたいです。
(2行目と3行目の様な形に。)
下記はコードAなど綺麗に並べられてますが、
実際はこれもバラバラに配置されています。

そこで下記のように作ったのですが、
,の位置がおかしくなったり、非常に見にくい処理となりました。。

,が正しく真ん中に来る書き方(最初と最後に,があったら取り除く方法)と、またはもっと良い方法がありましたら
お教えいただきたく思います。
どうぞ宜しくお願いいたします。

Dim i As Long
Dim lastrow As Long

With ThisWorkbook.Worksheets("重複削除")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

'並べ替え
.Range("A2:E" & lastrow).Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("E1"), Order2:=xlAscending, Key3:=.Range("A1"), Order3:=xlAscending

For i = lastrow To 2 Step -1

If .Cells(i, 2).Value = .Cells(i - 1, 2).Value And .Cells(i, 5).Value = .Cells(i - 1, 5).Value Then
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(i - 1, 3).Value = .Cells(i - 1, 3).Value & "," & .Cells(i, 3).Value
.Cells(i - 1, 4).Value = .Cells(i - 1, 4).Value & "," & .Cells(i, 4).Value

.Rows(i).Delete
End If
Next i

End With

元データ
コードA コードB 料金a 料金b コードC
100001 1001 60 a801
100002 1002 80 101 a602
100003 1002 102 a602
100004 1003 90 b302
100005 2001 32 c632
100006 2003 23 m523
100007 2004 50 f902
100008 2004 90 50 f902
100009 2005 20 41 g302
100010 2005 46 g302
100011 2005 39 45 g302
100012 2092 12 w231
100013 3040 60 90 z800
100014 6250 35 t230
100015 6250 90 t231

重複削除後↓↓

コードA コードB 料金a 料金b コードC
100001 1001 60 a801
100002 1002 80 101,102 a602
100004 1003 90 b302
100005 2001 32 c632
100006 2003 23 m523
100007 2004 90 50,50 f902
100009 2005 20,46,39 41,45 g302
100012 2092 12 w231
100013 3040 60 90 z800
100014 6250 35 t230
100015 6250 90 t231

< 使用 Excel:Excel2016、使用 OS:Windows10 >


100002と100007のマクロ実行結果が、重複削除後の例と違うのですが、余分なカンマを消したい、というだけで、データ的にはマクロの実行結果が正しい、と考えて良いですか?
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(i - 1, 3).Value = .Cells(i - 1, 3).Value & "," & .Cells(i, 3).Value
            .Cells(i - 1, 4).Value = .Cells(i - 1, 4).Value & "," & .Cells(i, 4).Value
             ↓
            .Cells(i - 1, 3).Value = .Cells(i - 1, 3).Value & IIf(.Cells(i - 1, 3).Value <> "" And .Cells(i, 3).Value <> "", ",", "") & .Cells(i, 3).Value
            .Cells(i - 1, 4).Value = .Cells(i - 1, 4).Value & IIf(.Cells(i - 1, 4).Value <> "" And .Cells(i, 4).Value <> "", ",", "") & .Cells(i, 4).Value

(???) 2019/02/27(水) 15:54


考え方は、以下です。 付けてからどうこうするのではなく、余分なカンマを付けない。
 空欄と空欄	カンマ不要
 空欄とデータ	カンマ不要
 データと空欄	カンマ不要
 データとデータ	カンマ付ける
(???) 2019/02/27(水) 16:00

???さん出来ました!
ありがとうございます。

ついでながらで申し訳ないのですが、
メンテナンスをしやすくしたいため
下記の4つの文?を変数化して、短くする方法はないでしょうか?

.Cells(i , 3).Value
.Cells(i - 1, 3).Value
.Cells(i , 4).Value
.Cells(i - 1, 4).Value
(マクロン) 2019/02/27(水) 17:10


ん〜、4つの値は田型にくっついているので、以下のように別のRange変数に置き換えるとか。
短くはなりますが、判りやすいかどうかは何とも言えません。
    Dim R As Range

    Set R = .Range(.Cells(i - 1, 3), .Cells(i, 4))
    R(1, 1) = R(1, 1) & IIf(R(1, 1) <> "" And R(2, 1) <> "", ",", "") & R(2, 1)
    R(1, 2) = R(1, 2) & IIf(R(1, 2) <> "" And R(2, 2) <> "", ",", "") & R(2, 2)
(???) 2019/02/27(水) 17:52

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.