エクセルのマクロでデータを左につめていく

質問

お世話になります。エクセル2002でマクロを作成しようと思っています。

毎回同じ処理をしているので、良いサンプルがあったら教えてください。

やりたいこと
　A列からF列にランダムにデータが入力されています。
　このデータをA列、B列、C列と、左に詰め表示させたいです。
　※G列以降にもデータが入力されていますが、処理したい列範囲はA列～F列です。
　※行数は、都度変わります。（UsedRange.Rows.Countで値を取得）

イメージ（処理前）
　-　 ：　空白セル　
***　：　データが入力されているセル

　　　 A列　　 B列　　C列　　D列　　E列　　 F列
1行目　項目1　項目2　項目3　項目4　項目5　項目6
2行目　***　 ***　 -　　 ***　 *** -
3行目　- -　　 -　 *** *** ***
4行目　***　 -　　 -　　 -　　 -　　 -　
5行目　*** *** -　　 *** -　　 -　

イメージ（処理後）
　　　 A列　　B列　　C列　　 D列　　E列　　F列
1行目　項目1　項目2　項目3　項目4　項目5　項目6
2行目　***　 ***　 -　　 ***　 *** -
3行目　*** *** *** - -　　 -
4行目　***　 -　　 -　　 -　　 -　　 -　
5行目　*** *** *** -　　 -　 -

回答No.5

mu2011 · ベストアンサー

一例です。

Sub sample()
Dim Wk(5) As Variant
With ActiveSheet.UsedRange
lastrow = .Cells(.Count).Row
End With
For i = 2 To lastrow
j = 0: Erase Wk
For k = 1 To 6
If Cells(i, k) <> "" Then
Wk(j) = Cells(i, k)
j = j + 1
End If
Next k
Range(Cells(i, 1), Cells(i, 6)).Value = Wk
Next i
End Sub

お礼

回答ありがとうございます。
やりたいことが実現できました。
配列を使って処理する方法は今回のような場合には効率的なのですね。
まだ勉強中なので、自分で教えて頂いたコードを勉強させてもらいたいと思います。
ありがとうございました。

回答No.4

Wendy02

こういう単純なマクロの質問って、結構落とし穴が一杯がありますね。

空白と言いながら、この前の人のように空白値にスペースが入っていることで、本当にブランクセルではないケースがあります。それで、こちらに文句を付けられてしまいました。ダメだったら、無視してくれればよいです。

>※G列以降にもデータが入力されていますが、処理したい列範囲はA列～F列です。

これは、F列までで、それ以降は、詰めたくないというケースですね。
それを読み取らないといけないようです。(マクロよりも、質問を読み取るほうが、何倍も難しいです。）

そうすると、1,2は、両方ともダメだということになります。それで考えたのは、3番目のコードです。(1,2は今回は取りやめ）Delete は、セル一つずつ削除せずに、Union などで、まとめて削除するというのが定石です。

以下は、配列を使っています。

処理後のイメージで、
2行目　***　　***　　　 -　　　　***　　 ***　　　-
なぜ、空白値が間に残っているか分かりません。もしかしたら、3行目からかな？

もしそうだったら、
　　Set rng = .Offset(2).Resize(.Rows.Count - 2, iCL) 'F列まで
となります。

'//
Sub Test3()
　Dim rng As Range
　Dim i As Long, j As Long
　Dim ar As Variant
　Dim arBuf() As String
　Dim cl As Variant
　Dim delRng As Range
　Const iCL As Long = 6 '列
　With ActiveSheet.UsedRange
　　Set rng = .Offset(1).Resize(.Rows.Count - 1, iCL) 'F列まで
　　ReDim arBuf(0, iCL - 1)
　　For Each cl In rng.Rows
　　　ar = Application.Index(cl.Value, 1, 0)　'配列に格納
　　　For i = 1 To UBound(ar)
　　　　If Trim(ar(i)) <> "" Then
　　　　　arBuf(0, j) = ar(i)
　　　　　j = j + 1
　　　　End If
　　　Next
　　　cl.Cells = arBuf
　　　ReDim arBuf(0, iCL - 1)
　　　j = 0
　　Next
　End With
End Sub

お礼

回答ありがとうございます。
質問から色々と読み取って頂いてありがとうございます。
配列の使い方もちょっと興味を持っているのですが、まだ勉強を始めたばかりなので、
少しずつ実例を使っていきながらステップアップさせてもらいたいと思います。

教えて頂いたサンプルさっそく利用させていただきます。

回答No.3

tom04

こんにちは！
一例です。

Sub test()
Dim i, j As Long
For i = 2 To ActiveSheet.UsedRange.Rows.Count
For j = 6 To 1 Step -1
If Cells(i, j) = "" Then
Cells(i, j).Delete (xlToLeft)
End If
Next j
Next i
End Sub

こんな感じですかね？
参考になれば良いのですが・・・m(__)m

お礼

回答ありがとうございます。
データが左に移動できました。
でも、G列、H列の値も左にずれていってしまいました。
あとは、自分で教えて頂いたコードを勉強して完成を目指したいと思います。

回答No.2

MackyNo1

例示のデータの2行目が良くわからないのですが、単純に空白セルを左側に詰めるなら以下のコードでどうでしょうか。

Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

お礼

回答ありがとうございます。

説明不足で申し訳ありません。
実際のデータは、2行目から入力されていて、1行目は表の項目データで、
マクロの対象にしたいセル範囲は、セルA2からです。とコメントを加えるべきでした。

教えて頂いた内容でデータ移動はできたのですが、対象はA列～F列のみにしたいので、
G列以降が移動しないように、自分で勉強して完成させて頂きたいと思います。
ありがとうございました。

回答No.1

nattocurry

Sub test()
Dim r As Long, c1 As Long, c2 As Long
For r = 2 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
For c1 = 1 To 5
If Cells(r, c1).Value = "" Then
For c2 = c1 + 1 To 6
If Cells(r, c2).Value <> "" Then
Cells(r, c1).Value = Cells(r, c2).Value
Cells(r, c2).ClearContents
Exit For
End If
Next c2
End If
Next c1
Next r
End Sub

結構無駄なことをしているので、もっと時間短縮できるスマートなマクロもあると思います。

お礼

ありがとうございます。やりたい通りのことが実現できました。
コードの内容はまた自分で勉強させてもらいます。