エクセルのマクロ（繰り返しについて）

質問

複数のセルの統合をしています。
目的：各セル内の文字を一つのセルに統合したいのです。
この作業をかなりたくさんせねばなりません。

現状行っていることは
(1)A1～A10まで、各セル改行ありで統合してます。
式にすると（A1&CHASE(10)&A2......)というような感じです。

この一連の統合作業を100以上行わねばなりません。
しかも、統合せねばならないセル数が上記のように（A1～A10）10個のセルとは限りません。

A11～A16のセルの統合もあれば、A16～A30のセルの統合もあります。

これをどうにか、マクロを使用して行いたいのですが、
どのようにすればセルの統合がスムーズにいきますでしょうか？

ちなみに、統合したいセルの和はkkkkkのいう文字が入っている、セルの直前までです。
つまり・・・
A1
A2
A3
A4(kkkkkk)→A3までを統合
・
・
・
A5
A6
A7
A8
A9
A10（kkkkkk）→A9までを統合。

色々と検索してみたのですが、良い方法が見つかりません。
ひたすら、数式を打ち込むしかないのでしょうか？

どなたかお知恵をお貸しください(T_T)
よろしくお願いいたします。

回答No.6

MarcoRossiItaly

ああ、すみません。No.3 ですが、ケアレスミスしましたね。すみません。No.3 の B2 の数式を次の 2 行の数式に差し替えてください。

B2

=if(a1="kkkkkk",a2,b1&"
"&a2)

なおご存じとは思いますが、セルの書式を「折り返して全体を表示する」に設定しないと表示上は改行されませんので、ご注意。

回答No.5

MackyNo1

実際のデータの配置や作業の目的が不明なので、最も効率的な操作が異なりますが、A列に連続して入力されているデータで特定の文字「kkkkk」までの文字をセル内改行を使って連結したいということなら以下のような文字の割り付けの機能を用いる方法で一括して実行できます。

B1セルに「=IF(A1="kkkkk","",A1&CHAR(10))」と入力して下方向にオートフィルコピーします。
その選択状態のまま、右クリックして「コピー」、もう一度右クリックして「形式を選択して貼り付け」で「値」にし、そのまま、「データ」「区切り位置」で「完了」します。
そのまま、Ctrl+Shift+→キーのショートカット操作でB列から最終列まで選択し、最後に「編集」「フィル」「文字の割り付け」をし（２００７以降のバージョンならホームタブの「編集」の中の下矢印アイコンをクリックして「両端揃え」を選択してください）、最後にもう一度右クリックして「セルの書式設定」の配置タブで「折り返して全体を表示する」を選択してみてください。

＃マクロで対応する場合も含めて、このようなご質問では正確なシートのレイアウトや目的を具体的に提示されないと的確な回答が得られないと思います。
また、Officeソフトはバージョンによって使用できる機能や操作方法が大きく異なりますので、質問の際には必ずバージョンを明記するようにしましょう。

回答No.4

tsubuyuki

言いたい事はいくつかありますが・・・

Sub sample()
Dim myStr As String
Dim i As Long, j As Long
　　　　With Columns(2)
　　　　　　　　.ClearContents
　　　　　　　　.MergeCells = False
　　　　End With

　　　　j = 1: myStr = ""
　　　　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　　　If Cells(i, 1) = "kkkkkk" Then
　　　　　　　　　　　　With Range(Cells(j, 2), Cells(i - 1, 2))
　　　　　　　　　　　　　　　　.WrapText = True
　　　　　　　　　　　　　　　　.MergeCells = True
　　　　　　　　　　　　End With
　　　　　　　　　　　　Cells(j, 2) = Left(myStr, Len(myStr) - 1)
　　　　　　　　　　　　j = i + 1: myStr = ""
　　　　　　　　Else
　　　　　　　　　　　　myStr = myStr & Cells(i, 1) & vbLf
　　　　　　　　End If
　　　　Next
End Sub

こういうことでしょうか。

> 統合したいセルの和はkkkkkのいう文字が入っている、セルの直前までです。
これが可変で「jjjjjj」もありえる、なんていう場合は、
ここまでお三方が下さったご回答も「全て」無駄になってしまいます。

質問の際は「詳細を含めて」いただけないと、回答のしようが無いことをご考慮下さい。
回答に補足で「実は・・」「追加で・・」とやっていくと、本気でキリが無いですから。

回答No.3

MarcoRossiItaly

＞統合したものは、AのとなりのB列に示したいです！

何だかよく分からないので、具体的なことを説明してほしいのですが…。

もしかして、質問文にある「A4(kkkkkk)→A3までを統合」とは、「結合した文字列を B4 セルに記入し、セルの結合はどこにも施さない」という意味でしょうか？何となく今、そんな気がしてきました。そうであれば、もう回答が出ていますね。

ちなみに Excel において「統合」とは、重複しているデータの削除、合算などを行う機能のことで、ご質問の内容とは全く異なるものです。

マクロを使いたいとのことですが、できれば質問者さんが既に調べたこと、途中まででも書いてみたコードを載せていただきたかったです。何しろここは QA サイトであり、業務委託ではなく、質問をする場なので…。

なお、セルに

B1　=a1
B2　=if(a1="kkkkkk",a2,b1&a2)
C2　=a1="kkkkkk"
　　あるいは
　　=0+(a1="kkkkkk")

と記入して B2 と C1 からそれぞれ下方向にオートフィルし、値複写で数式を除き、オートフィルタで「kkkkkk」でない行を抽出し、関係ない行をクリアすれば、お望みの結果は Excel の一般機能だけでサッとできてしまいます。たくさん繰り返す予定でもない限りマクロを使うまでもありませんので、ご参考に。

回答No.2

emaxemax

No1の方の回答はkkkkの右のB列に統合した文字データを表示する方法ですね。
では、わたしはそうではなくA列自体のセル自体を結合させ、そこに統合した文字データを表示する方法をやってみました。

Sub test01()
　　Dim n As Long
　　Dim Rng As Range, myC As Range
　　Dim myStr As String
　　For n = 1 To Cells(Rows.Count, "A").End(xlUp).Row
　　　　If Cells(n, "A").Value <> "kkkkkk" Then
　　　　　　If Rng Is Nothing Then
　　　　　　　　Set Rng = Cells(n, "A")
　　　　　　Else
　　　　　　　　Set Rng = Union(Rng, Cells(n, "A"))
　　　　　　End If
　　　　Else
　　　　　　If Not Rng Is Nothing Then
　　　　　　　　For Each myC In Rng
　　　　　　　　　　myStr = IIf(myStr = "", myC.Value, myStr & Chr(10) & myC.Value)
　　　　　　　　Next myC
　　　　　　　　Application.DisplayAlerts = False
　　　　　　　　Rng.Merge
　　　　　　　　Application.DisplayAlerts = True
　　　　　　　　Rng.Value = myStr
　　　　　　　　myStr = ""
　　　　　　　　Set Rng = Nothing
　　　　　　End If
　　　　End If
　　Next n
End Sub

回答No.1

keithin

文字列結合した結果を「どこに」表示したいのですか。

作成例：
sub macro1()
　dim buf as string
　dim r as long
　range("B:B").clearcontents

’上から下まで繰り返す
　for r = 1 to range("A65536").end(xlup).row
　　if cells(r, "A") = "(kkkkk)" then
　　’kkk行の処理
　　　cells(r, "B") = mid(buf, 2)
　　　cells(r, "B").wraptext = true
　　　buf = ""
　　else
　　’それ以外の処理
　　　buf = buf & vblf & cells(r, "A").value
　　end if
　next r
end sub

補足

さっそくご回答ありがとうございます！統合したものは、AのとなりのB列に示したいです！