about excel

質問

毎度お世話になります。
重複しますが質問させて下さい。
簡単に言うとA,B列でA列に入力されている数字（シリアルNO.）が同じでB列の内容（症状）が違うものを同じセルに挿入出来る機能はありますか？

回答No.2

noname#95859 · ベストアンサー

データの入ったブックを開いてください。そして、
(1) 「ツール／マクロ／新しいマクロの記録」、を選択
(2)　－「マクロの記録」ウィンドウにて「OK」を押す
(3) 「ツール／マクロ／記録終了」、を選択
再び

(4) 「ツール／マクロ／マクロ」、を選択
(5)　－「マクロ」ウィンドウにて「Macro1」を選択して、「編集」を押す
出てきた画面で、すべての記述を削除する。

例：
-------------------------------------------
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2007/3/27 ユーザー名 : Administrator
'

End Sub
-------------------------------------------
上記のようなものが出てきますが、すべて削除です。
(6) 代わりに、
'-------------------------------------------
Sub Macro1()
Dim E_rowpos As Integer
Dim rowpos As Integer
Cells.Sort Key1:=Columns("A"), Order1:=xlAscending, Header:=xlYes
E_rowpos = Cells(65536, 1).End(xlUp).Row - 1
rowpos = E_rowpos
Do While rowpos <> 1
Cells(rowpos, 1).Select
If Cells(rowpos, 1).Value = Cells(rowpos + 1, 1).Value Then
Cells(rowpos, 2).Value = Cells(rowpos, 2).Value & vbLf & Cells(rowpos + 1, 2).Value
Cells(rowpos, 3).Value = 1
Cells(rowpos + 1, 3).EntireRow.Delete
End If
rowpos = rowpos - 1
Loop
End Sub
'--------------------------------------------
このマクロをペーストします。（前回のものと、一部異なっています）
VBAエディタのウィンドウをフルではなく、小さめにしてください。

(7) この段階で、一度「保存」してください。

(8) 次に、対象のシートを選んでください。
(9) スクリーンの下に「VBA」のアイコンがあると思います。押下して、VBAエディタを前面に出してください。 [Alt][tab]でも、機能します。
(10) 先の貼り付けたマクロ"Macro1"の内部（例えば、2行目の「Dim」）をクリックしてください。
(11) [F8]を押してください。"Sub Macro1()"の部分が黄色くなったはずです。（黄色くなったということは、マクロが動き始めたということです）
(12)続けて [F8]を押してください。押すたびに、黄色いラインが移動するはずです。しばらく、我慢して、そのまま、[F8]を押したままにしてください。　データシート上で、同じ、シリアル番号のところでは、B列の内容が足し合わされ、かつ、　不要となった行が削除される様が見えるはずです。
(13) 適当なところで、[F5]を押してください。一気に、最後まで、行きます。

万一に備えて、作業を始める前に、バックアップを取っておいてください。

以上です。無事に、完了することを祈ります。

お礼

ご回答ありがとうございました。
無事完了しました。
ありがとうございました。

回答No.1

noname#95859

A列の内容が同じ複数の行が存在する場合、対応するB列のデータを、ひとつのセルに
集めて、A列の内容で見た場合、重複の無いようにすることを、以下のマクロで実現しました。
このマクロでは、重複する行が3行、4行あっても、機能します。
但し、重複している行は、B列のデータを集めた後、削除してしまいますので、
バックアップを取って置いてください。
-----------------------------------------------------
Sub Macro1()
Dim E_rowpos As Integer
Dim rowpos As Integer
Cells.Sort Key1:=Columns("A"), Order1:=xlAscending, Header:=xlYes
E_rowpos = Cells(65536, 1).End(xlUp).Row - 1
rowpos = E_rowpos
Do While rowpos <> 1
If Cells(rowpos, 1).Value = Cells(rowpos + 1, 1).Value Then
Cells(rowpos, 2).Value = Cells(rowpos, 2).Value & vbLf & Cells(rowpos + 1, 2).Value
Cells(rowpos, 3).Value = 1
Cells(rowpos + 1, 3).EntireRow.Delete
End If
rowpos = rowpos - 1
Loop
End Sub

補足

ご回答ありがとうございます。
当方マクロについては全く分かりません。
お手数ですがツール→マクロの先どうしたらいいのかもう詳細教えて頂けますか。
よろしくお願いします。