EXCELで3行を一組にして結合する方法について

かなりの行があるテキストファイルをEXCELに読み込みます。
3行が1組になっているので、別のBというシートにその3行を連結した結果を書き出します。
（3行といっても1行には1セルしかありませんが・・・）
次に4行目～6行目が1組になっているので、上記と同様にBシートの2行目に連結した結果を書き出します。
これは、手で１行づつBシートに
=A1&A2&A3 、次の行に =A4&A5&A6

等と式を記載すれば希望のものが出来るのですが、場合によっては元の行が30,000行ほどあったりするので、それを全て手で入力していくには、根気と時間が必要になります。
この作業は、毎日発生する予定で、他の仕事もやらなくてはならないため、短時間にこれを実現できれば・・・と、思っていますが、何をどうすれば良いのかわからずにいます。

これを解決できる方法がありましたら、是非教えて頂けると助かります。
ちなみにEXCEL XP（OfficeXPに付属）のものです。
例えば、EXCELではなく、＊＊＊というフリーのソフトならできます！というのも歓迎です。
すみませんが、宜しくお願いします。

No.5 ベストアンサー 回答者： tom04 回答日時： 2011/03/18 22:12

こんばんは！

一例です。
画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面がでますので
↓のコードをコピー＆ペーストし、マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）
Sheet1のデータは1行目からあるとします。

Sub test() 'この行から
Dim i As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1") '←Sheet名（Sheet1の部分）は適宜変更してください。
Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row Step 3
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
ws1.Cells(i, 1) & ws1.Cells(i + 1, 1) & ws1.Cells(i + 2, 1)
Next i
End Sub 'この行まで

お役に立てば良いのですが・・・m(__)m

この回答へのお礼

自宅のEXCELのVerが違うためか、マクロを実行できるようにするために少し手間取りましたが、希望通りのものが実行できました！
とっても感激です。
本当にありがとうございました！！

お礼日時：2011/03/19 11:23

No.13 回答者： bin-chan 回答日時： 2011/03/19 13:48

＃１、＃３です。

他の方の回答に「下方向にコピーするのが大変」的な部分がありますが、何万行あっても、スクロールさせる必要はありません。対応方法はあります。

そのために＃３では連番を設け、選択セル範囲の右下■（フィルハンドル）をダブルクリックするのです。
（空白行削除のための並べ替え後に、値がある列Ａを元の順序に戻すためでもありますが）

コピー後、下の端を確認するためには「選択セル範囲の下辺」をダブルクリックしてください。
連続した領域の最終行までジャンプします、

各辺とも同じ動作で、選択した方向の端に移動します。
途中、途切れていることが明らかなら、Ctrl＋下矢印キーか、Ctrl+Endキー押下です。
セルA1に戻るにはCtrl+Homeキー。

さらにShiftキーも合わせて押さえておけば範囲範囲選択が可能です。

この回答へのお礼

これまでわざわざ下までスクロールして連番付けやコピーをしていました。
とってもいいことを教えていただき、有難うございました！

お礼日時：2011/03/22 19:30

No.12 回答者： mar00 回答日時： 2011/03/19 02:21

新規のブックで

ツール→マクロ→Visual Basic Editerを選択
挿入→標準モジュールを選択
そこにマクロをコピーして貼り付けて下さい
ツール→ユーザー設定→コマンドタブの分類マクロ→ユーザー設定ボタンを出す
選択したボタンの編集でボタンの表示のしかたを変更できます。
選択したボタンの編集→マクロを登録→Macro1を選択してOK
名前をつけて保存してください、

Sub Macro1()
Dim WS1 As Worksheet
Dim GYOU As Long
Set WS1 = Worksheets("Sheet1")
Sheets.Add
NN = WS1.Cells(Rows.Count, 1).End(xlUp).Row
GYOU = 0
For i = 1 To WS1.Cells(Rows.Count, 1).End(xlUp).Row Step 3
GYOU = GYOU + 1
Range("A" & GYOU) = WS1.Range("A" & i) & WS1.Range("A" & i + 1) & WS1.Range("A" & i + 2)
Next i
Windows(ThisWorkbook.Name).Close False
End Sub

"Sheet1"のところは適宜修正してください。前日のテキストデータを残しておく必要がある場合は
名前を変更して保存しておいて、テキストデータを毎回同じ名前で保存しておけば１度の修正で済むと思います。
テキストファイルをEXCELに読み込み、ボタンをクリックすればマクロが実行されます。

この回答へのお礼

自宅のPCでやってみましたが、EXCELのVerが違うせいか、うまくVisual Basic Editerを起動することができませんでした。
休み明けに会社のPCで試してみますが、取り急ぎ御礼まで。

早速お教え頂き、ありがとうございました。

お礼日時：2011/03/19 11:05

No.11 回答者： neochi_life 回答日時： 2011/03/19 01:16

５番さんへ

なんども；；

ちょっと見間違いをしてまして、いらないこと書き失礼しました
step 3
ですものね。セル指定合ってますよね・・・

No.10 回答者： neochi_life 回答日時： 2011/03/19 01:05

５番さんへ

記述内容はほぼ一緒ですが記述中、ループ内で元データを３個ごとに結合する部分で誤りがあります
参考としてこんな感じ～で書かれたのだと思いますが一応。

ws1.Cells(i, 1) & ws1.Cells(i + 1, 1) & ws1.Cells(i + 2, 1)
ですが、一回目の読み込みでは
ws1.Cells(1, 1) & ws1.Cells(2, 1) & ws1.Cells(3, 1)
となり正常にセルの内容を結合しますが

ではi=2以降は？
ws1.Cells(2, 1) & ws1.Cells(3, 1) & ws1.Cells(4, 1)
ws1.Cells(3, 1) & ws1.Cells(4, 1) & ws1.Cells(5, 1)
ws1.Cells(4, 1) & ws1.Cells(5, 1) & ws1.Cells(6, 1)
・・・・
となり重複して元データの内容を書き出してしまいます

質問主の意図する結合は
ws1.Cells(1, 1) & ws1.Cells(2, 1) & ws1.Cells(3, 1)
ws1.Cells(4, 1) & ws1.Cells(5, 1) & ws1.Cells(6, 1)
ws1.Cells(7, 1) & ws1.Cells(8, 1) & ws1.Cells(9, 1)
・・・・
だと思います

No.9 回答者： neochi_life 回答日時： 2011/03/19 00:09

２です。

マクロを使用する場合には、「ツール＞マクロ＞セキュリティー」から、セキュリティーレベルを中に設定
自分でテストデータ作って動くことを確認したものを参考に張っておきます
一応、これで「自作のフリーソフト」ができます

以下手順

・新しいファイルを作ります（作業用です）
・Alt+11でビジュアルベーシックエディターを開き、Module1を追加する
・以下をまるごと貼り付ける

' ---------- 内容始まり ----------
Private Sub 作業()
Dim 合成 As Variant
Dim i, j, l As Integer
Dim 最終行 As Integer

合成 = ""
j = 1
l = 2
m = 0
Sheets("sheet2").Select 'コピー元のシートに切替
最終行 = Cells(1, 1).End(xlDown).Row

For i = 3 To 最終行 Step 3
合成 = Cells(j, 1) + Cells(l, 1) + Cells(i, 1)
j = j + 3
l = l + 3
Sheets("sheet1").Select 'コピー先のシートに切替
m = i / 3
Cells(m, 1) = 合成
Sheets("sheet2").Select 'コピー元のシートに切替
Next
Sheets("sheet1").Select 'コピー先のシートに切替
End Sub
' ---------- 内容終わり ----------

・Ctrl+S　で保存する
・次に、Module1のちょっと上にあるThis Workbookをダブルクリックして以下の記述を丸ごと貼り付ける

' ---------- 内容始まり ----------
Private Sub Workbook_Open()
Application.OnKey "^{q}", "作業"　'Ctrl+Qボタンを押すとマクロが動きます
End Sub
' ---------- 内容終わり ----------

・Ctrl+S　で保存する
・一度閉じてからもう一度開く（確認ダイアログが出るので、「マクロを有効にする」を選ぶ）

ここまでで準備ができました

使い方
・元になるシートをsheet2として、元になるシートを丸ごとコピペしておきます
・出力先になるシートをsheet1として、シート内容をクリアしておきます
・Ctrl+Qを押すと、シート２の内容を３行ずつを1行につなげて、シート１に書き出します
・元データが「３行１セットである前提」で、何行あっても最終行まで書き出します
・３行１セットが崩れてたらエラーが起きます
・シート１に書き出されたデータを、保存するファイルに丸ごとコピペします

--------------------------------
他の方が言われてるように、関数式をどこかに保存しておいて、使う時に貼り付けて必要な行だけドラッグしつつコピーでもいいですが、元データが３万行とかもしかするとそれ以上あるんですよね？ということは、自分でドラッグするのは１万行以上あるわけです。
それもけっこう大変だろうなのでは？と思い、マクロを作ってみました

この回答へのお礼

早速お教え頂き、ありがとうございます。

試してみたのですが、会社のEXCELのVerと違うせいか、10行目あたりで”実行時エラー １００４”というダイアログが表示されてしまい、先に進めませんでした。
休み明けに会社のPCで試してみます！
取り急ぎ、御礼まで。

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

お礼日時：2011/03/19 11:34

No.8 回答者： keithin 回答日時： 2011/03/18 22:40

＞この作業は、毎日発生する予定で

ということなので。

BのシートのA1に
=Sheet1!A1&Sheet1!A2&Sheet1!A3
を記入
A1:A3を選んだ状態から，リストの下端までえいやーーーっとオートフィルドラッグ

この状態から，さらに
A列を列選択
Ctrl+Gをおす
現れたダイアログでセル選択をクリックする
現れたダイアログで空白セルにマークしてOKする
空白のままだった２セルずつが飛び飛びに選択されるので，右クリックして削除で上に詰める

以上で所定の式を希望の並びに詰めて配置できたので，毎日のデータはシート１に上書きで貼り付けてしまえば，数式のシートが即座にコタエを並べて出してくれます。
（形式を選んで値に貼り替える必要はまったくありません）

この回答へのお礼

早速ご回答いただき、ありがとうございました。
あらから自宅に帰り、何度か試してみましたが、うまくいきませんでした。
きっと、会社と自宅のVerが違うかもしれません。
休み明けに会社で再度試してみたいと思います。
本当にありがとうございます。
取り急ぎ、お礼まで。

お礼日時：2011/03/19 09:01

No.7 回答者： mike_g 回答日時： 2011/03/18 22:25

[No.6]の式は、次式と同じことですが、こちらの方が少し短いです。

=INDEX(Sheet1!A:A,ROW(A1)*3-2)&INDEX(Sheet1!A:A,ROW(A1)*3-1)&INDEX(Sheet1!A:A,ROW(A1)*3)

No.6 回答者： mike_g 回答日時： 2011/03/18 22:20

=INDEX(Sheet1!A:A,ROW(A1)*3-2)&INDEX(Sheet1!A:A,ROW(A1)*3-2+1)&IN

DEX(Sheet1!A:A,ROW(A1)*3-2+2)

No.4 回答者： aoumiushi 回答日時： 2011/03/18 22:12

こんな感じかな？

VBA使用します。
但しA列の表示形式が、文字列の場合のみです。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, b As Integer
Dim c As String
a = 0 '初期化
b = 0 '初期化
c = "" '初期化

For i = 1 To 25 'MAXの行数に変更
c = c + Cells(i, 1).Value
a = a + 1
If a = 3 Then
b = b + 1
Cells(b, 2).Value = c
c = ""
a = 0
End If
Next
End Sub
きたない式ですみません。

この回答へのお礼

早速お教え頂き、ありがとうございます！

自宅のPCで試したところ、マクロが実行できず、うまくいきませんでした。
ひょっとしたら、EXCELのVerが違うかもしれません。。
休み明けに会社のPCで試してみますが、取り急ぎ、御礼まで。

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

お礼日時：2011/03/19 11:39