EXCEL VBA 条件による空白挿入

EXCEL2003を使っています。
以下のように列ＦＧＨが空白の行については列ＡＢＣを空白を挿入したいのですが数万行あり処理をＶＢＡで自動化したいです。どなたかお力をお貸し下さい。お願いします。

A B C D E F G H
1 1 2 3 4 5 6 7 8
2 1 2 3 4 5 _ _ _
3 1 2 3 4 5 6 7 8
4 1 2 3 4 5 _ _ _
5 1 2 3 4 5 6 7 8

↓

A B C D E F G H
1 1 2 3 4 5 6 7 8
2 _ _ _ 1 2 3 4 5
3 1 2 3 4 5 6 7 8
4 _ _ _ 1 2 3 4 5
5 1 2 3 4 5 6 7 8

No.1 ベストアンサー 回答者： eden3616 回答日時： 2014/08/07 20:02

▼VBAコードの登録方法

(1)Alt+F11でVBEを開き、挿入→標準モジュールを挿入
(2)最下のVBAコードを貼り付け
(3)右上の×またはAlt+F11でVBEを終了

▼使用方法

対象の範囲を選択（ご提示のデータではA1：H5をセル選択）した状態で
Alt+F8または表示→マクロから「右詰」を選択して実行してください


■VBAコード

Sub 右詰()
Dim i As Long
Dim j As Long
Dim word As String
Dim myRng As Variant
Dim otRng As Variant
Dim cnt As Long
Dim n As Integer
Application.ScreenUpdating = False
For i = 1 To Selection.Rows.Count
　　word = ""
　　myRng = Range(Selection.Cells(i, 1), Selection.Cells(i, Selection.Columns.Count))
　　For j = 1 To UBound(myRng, 2)
　　　　If Len(myRng(1, j)) > 0 Then
　　　　　　word = word & "\t" & myRng(1, j)
　　　　End If
　　Next j
　　otRng = Split(word, "\t")
　　cnt = Selection.Columns.Count
　　For j = UBound(otRng) To 1 Step -1
　　　　Selection.Cells(i, cnt) = otRng(j)
　　　　cnt = cnt - 1
　　Next j
　　If cnt > 0 Then
　　　　Range(Selection.Cells(i, 1), Selection.Cells(i, cnt)).ClearContents
　　End If
　　n = Int(i * 100 / Selection.Rows.Count)
　　If n Mod 2 = 0 Then
　　　　Application.StatusBar = n & "% 完了"
　　　　DoEvents
　　End If
Next i
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

この回答へのお礼

イメージどおりに動きました。ありがとうございました！

お礼日時：2014/08/08 08:35