2行目と3行目を1行目に右側につけて、空白を削除してつめるコードが知りたいです。

1
2
3

4
5
6

7
8
9
.
.
.

A1「1」、A2「2」、A3「3」A4空白、A5「4」、、、と言う風なデータがあるの
ですが、
これを

123
456
789
...

と言う風に2行目と3行目を1行目に右側につけて、空白を削除してつめるコー
ドが知りたいです。

実際のデータは数値ではなく文字列です。
よろしくお願いします。

No.1 回答者： n-jun 回答日時： 2007/12/30 21:44

>と言う風に2行目と3行目を1行目に右側につけて

ひとつのセルに連結させるのですか？
それとも、Ｂ・Ｃ列に移すのですか？

この回答へのお礼

B列、c列に移したいです。よろしくお願いします。

お礼日時：2007/12/31 13:12

No.2 回答者： zap35 回答日時： 2007/12/30 22:13

「コード」とありますがマクロでなくても関数でできます。

同じシートの適当なセルに以下の式を貼り付けて下方向にコピーしてください。ただしデータはA列にあるものとしています。違う列なら「$A$1」を「$C$1」のように変更してください。「Z1」の箇所は行番号を生成するためのものですから変更は不要です。

=OFFSET($A$1,INT((ROW(Z1)-1)*4),0)&OFFSET($A$1,INT((ROW(Z1)-1)*4+1),0)&OFFSET($A$1,INT((ROW(Z1)-1)*4+2),0)

またマクロがよいなら以下のようなサンプルでもできます。
元のデータは消してしまわないよう、新しいシートに書き込むようにしています。データ列は２行目で指定してください

Sub Macro1()
Const trg As String = "A" '文字列が入力された列を指定する
Dim idx, cnt As Long
Dim act As Worksheet
Set act = ActiveSheet
Worksheets.Add after:=act
For idx = 1 To act.Cells(65536, trg).End(xlUp).Row Step 4
　　cnt = cnt + 1
　　Cells(cnt, trg).Value = act.Cells(idx, trg).Value & _
　　　　　　act.Cells(idx, trg).Offset(1).Value & act.Cells(idx, trg).Offset(2).Value
Next idx
End Sub

でも実際のシートは質問通りではないように思いますので修正が必要かもしれませんね。もしそうならご自身で修正してください。

この回答への補足

回答していただいて申し訳ないのですが、２をB列、3をc列と言う風にしたいです。説明不足ですいません。よろしくお願いします。

補足日時：2007/12/31 13:13

No.3 回答者： imogasi 回答日時： 2007/12/31 13:14

同一シート（のF列に出す例）でよいなら

Sub test01()
d = Range("A65536").End(xlUp).Row
k = 1
For i = 1 To d Step 4
Cells(k, "F") = Cells(i, "A") & Cells(i + 1, "A") & Cells(i + 2, "A")
k = k + 1
Next i
End Sub
ーー
データ例A1:A11
a
b
c

d
e
f

g
h
i
ーー
F1:F3
abc
def
ghi
既回答とほぼ同じですが。

この回答へのお礼

大変参考になりました。ご回答ありがとうございます。

お礼日時：2008/01/03 23:09

No.4 回答者： n-jun 回答日時： 2007/12/31 13:53

>B列、c列に移したいです。

よろしくお願いします。
だとすると、

Sub　test()
　　Dim　v,　x
　　Dim　i　As　Long
　　
　　With　ActiveSheet
　　　　　　　v　=　.Range(.[A1],　.Cells(Rows.Count,　1).End(xlUp)).Value
　　　　　　　ReDim　x(1　To　(UBound(v)　+　1)　/　4,　1　To　3)

　　　　　　　For　i　=　1　To　UBound(x,　1)
　　　　　　　　　　　x(i,　1)　=　v((i　-　1)　*　4　+　1,　1)
　　　　　　　　　　　x(i,　2)　=　v((i　-　1)　*　4　+　2,　1)
　　　　　　　　　　　x(i,　3)　=　v((i　-　1)　*　4　+　3,　1)
　　　　　　　Next
　　　　　　　.Range("A:A").ClearContents
　　　　　　　.Range("A1").Resize(UBound(x,　1),　3).Value　=　x
　　End　With
End　Sub
こんな感じでしょうか？

この回答へのお礼

大変参考になりました。ご回答ありがとうございます。

お礼日時：2008/01/03 23:09

No.5 ベストアンサー 回答者： zap35 回答日時： 2007/12/31 16:22

＃０２です

＞２をB列、3をc列と言う風にしたいです

関数なら、以下を同じシートの適当なセルに貼り付けて右方向、下方向にコピー
=OFFSET($A$1,INT((ROW(A1)-1)*4)+COLUMN(A1)-1,0)

マクロなら以下でできるでしょう
Sub Macro1()
Const trg As String = "A" '文字列が入力された列を指定する
Dim idx, cnt As Long
Dim act As Worksheet
Set act = ActiveSheet
Worksheets.Add after:=act
For idx = 1 To act.Cells(65536, trg).End(xlUp).Row Step 4
　　cnt = cnt + 1
　　Cells(cnt, trg).Value = act.Cells(idx, trg).Value
　　Cells(cnt, trg).Offset(0, 1).Value = act.Cells(idx, trg).Offset(1).Value
　　Cells(cnt, trg).Offset(0, 2).Value = act.Cells(idx, trg).Offset(2).Value
Next idx
End Sub

この回答へのお礼

大変参考になりました。ご回答ありがとうございます。

お礼日時：2008/01/03 23:09