初心者です。
ExcelVBA2007で、A3:G15の表があります。(さらに実際は横にも同じようにI3:O3にもさらに下にも同じような表がいくつかあります)
この表は、行ごとに1セットになっています。(例えばA3に分類、B3に商品名・・・G3に数のように)
この表の所々に空欄があるのですが、一つの表の中の行がすべて空欄であれば上に詰めていきたいと思っていますがうまくいきません。後、D列には数式が入っているのですが処理がかわってくるのでしょうか?(今後数式を入れない方向に変えようかとも思っています)
どうすればよいでしょうか?
もしよかったら、同じ表に対する繰り返し処理のスマートな表記があれば教えていただければありがたいです。
申し訳ございませんが、ご教授よろしくお願いいたします。
No.3ベストアンサー
- 回答日時:
IF の条件が同一で複数の処理を行う場合、1つのIFでまとめられます。
というのは多分ご存じですよね。
全体の処理を7回繰り返しているとのことですが、空白行が多いと処理漏れが出てくるのでは…?
「On Error」は「.SpecialCells(xlCellTypeConstants)」のためのものですよね?
すみません、以下、勝手にいじったものをあげておきます。
時間の都合と、私の能力の関係で、汚く見づらいと思いますので覚悟して眺めてください。
認識が違っているかもしれませんが、どこかしら役に立つ部分があれば、と期待しつつ。
Sub aaa()
Dim i As Integer, x As Integer, y As Integer
Application.ScreenUpdating = False
Flag = 0 '★1回だけの処理で使うフラグ
' For i = 1 To 7 ★1回で済ませたいのでコメント化
For x = 14 To 3 Step -1 '15行→3行まで処理をします。
CSUM = 0 '列の文字数を数える変数CSUMを用意し、初期値0とします。
For y = 1 To 7 'A列(1列)→G列(7列)まで処理をします。
CSUM = CSUM + Len(Cells(x, y)) 'CSUMにセル(x,y)の文字数を足します。
Next '列処理繰り返し
' On Error Resume Next ★「On Error」嫌いなのでコメント化
If CSUM = 0 Then
Range(Cells(x + 1, 1), Cells(15, 7)).Copy '★空白行の1行下から15行目までをコピー
Cells(x, 1).PasteSpecial '★空白行の1列目のセルを基点として貼り付け
If Flag = 0 Then '★15行目の値クリア処理 1回だけの処理
Cells(15, 1) = 1 '★15行目がすっからかんのときエラーになるので、暫定入力
Range(Cells(15, 1), Cells(15, 7)).SpecialCells(xlCellTypeConstants).ClearContents
End If '★1回だけの処理 ここまで
Flag = 1 '★1回だけの処理させないためフラグ値変更
End If
Application.CutCopyMode = False
' On Error GoTo 0 ★「On Error」嫌いなのでコメント化
Next '行処理繰り返し
' Nex ★1回で済ませたいのでコメント化
End Sub
★のコメントが、今回いじったあたりもの
空白行発見時、
その下の行から15行目までをコピー → 空白行から貼り付け
としています。
これで、7回ループしなくて良くなると思います。
15行目のクリアは1回実行すれば不要となるので、変数「Flag」を用意しました。
Flag = 0 のときに1度実行。その後、Flag = 1 とすることで、以降処理を省きます。
15行目が全くカラの状態だと「.SpecialCells(xlCellTypeConstants)」でエラーとなるので、暫定的に「1」を入力しています。
これで、私があんまり使いたくない「On Error」を使わずに済みます。
ほかの処理だと・・・
空白行を上に詰めて、最後に表範囲に罫線を引き直すという
という方法もありますよね。
さらに考えていただきどうもありがとうございます。
試してみました。
こっちの方が、処理が速くていいですね。
解説もつけていただきどうもありがとうございます。
感謝です。
No.2
- 回答日時:
ごめんなさい、対象のセル範囲を[C3:G15]としてました。
こちら、[A3:G15]としたものです。
Sub aaa()
For x = 15 To 3 Step -1 '15行→3行まで処理をします。
CSUM = 0 '列の文字数を数える変数CSUMを用意し、初期値0とします。
For y = 1 To 7 'A列(1列)→G列(7列)まで処理をします。
CSUM = CSUM + Len(Cells(x, y)) 'CSUMにセル(x,y)の文字数を足します。
Next '列処理繰り返し
If CSUM = 0 Then Range(Cells(x, 1), Cells(x, 7)).Delete Shift:=xlUp '文字数が0なら、範囲x行のA~G列(1~7列)までを削除して上へ詰めます。
Next '行処理繰り返し
End Sub
<流れを簡単に…>
15行から3行に向かい、以下の処理をする。
その行のA列にあたるセルからG列にあたるセルまでの文字数を順に足していく。
その行の文字数が0だったら、その行のA列~G列を削除し、上へ詰める。
なお、D列に数式が入っているとのことですが、結果として空白(文字が無い)のであれば空欄として処理します。
さて、セル範囲を間違ったものをアップしてしまっていたわけですが・・・
・表の一部が削除されるので表がくずれてしまう
の部分については、修正がさほど難しい部類ではありません。
これに気付けないとなると、参考となるマクロを教えていただいても、ここから編集、改良は難しいのでは…と心配です。
・表の途中に何も入力しない行をつくって下の行にある文字が上の何も入力していない行に詰めてくれませんでした。
こちらについては原因がわかりませんが、今回もので、セル範囲[A3:G15]の中で試してみてください。
お役にたてれば幸いです。
この回答への補足
どうもありがとうございます。
一応、このコードを元につくってみて思い通りに動作するようになりました。
Delete の所を1行下をコピーして貼り付けるようにしました。
空白行の状態では、上に詰まりきらないので全体を繰り返しました。色々試した結果3~15行までの13行に対して半分程度の7回繰り返せば大丈夫でした。
後、気になるのがコードの書き方です。追加した部分がIf CSUM = 0を連続で書いています。elseとかで書こうとしたのですが、ForがないとかEnd ifがないとかでエラーになってしまいしょうがなく、このような書き方になってしまいました。
一応思い通りの動作なので問題ないのですが、勉強のためにもっとスマートな書き方があればご教授ください。
Sub aaa()
Dim i As Integer, x As Integer, y As Integer
Application.ScreenUpdating = False
For i = 1 To 7
For x = 14 To 3 Step -1 '15行→3行まで処理をします。
CSUM = 0 '列の文字数を数える変数CSUMを用意し、初期値0とします。
For y = 1 To 7 'A列(1列)→G列(7列)まで処理をします。
CSUM = CSUM + Len(Cells(x, y)) 'CSUMにセル(x,y)の文字数を足します。
Next '列処理繰り返し
On Error Resume Next
If CSUM = 0 Then Range(Cells(x + 1, 1), Cells(x + 1, 7)).Copy
If CSUM = 0 Then Range(Cells(x, 1), Cells(x, 7)).PasteSpecial
If CSUM = 0 Then Range(Cells(x + 1, 1), Cells(x + 1, 7)).SpecialCells(xlCellTypeConstants).ClearContents
Application.CutCopyMode = False
On Error GoTo 0
Next '行処理繰り返し
Next
End Sub
No.1
- 回答日時:
どの部分で詰まっているのかよくわかりませんが・・・
Sub aaa()
For x = 15 To 3 Step -1
CSUM = 0
For y = 3 To 7
CSUM = CSUM + Len(Cells(x, y))
Next
If CSUM = 0 Then Range(Cells(x, 3), Cells(x, 7)).Delete Shift:=xlUp
Next
End Sub
とりあえず、これで足りないところをあげてみるとか。(^_^;
この回答への補足
すいません、変えながら色々やってみましたがやはりうまくいきません。表の一部が削除されるので表がくずれてしまうし、動作も表の途中に何も入力しない行をつくって下の行にある文字が上の何も入力していない行に詰めてくれませんでした。
補足日時:2014/12/07 09:34お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelの相談 4 2023/03/03 09:51
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Excel(エクセル) 下記エクセルの式がなぜこうなるのか理由が知りたいです。 6 2022/08/20 00:43
- Excel(エクセル) エクセルの散布図で新たに入力した値のデータラベルが空欄になる現象 1 2022/04/26 09:31
- Excel(エクセル) 特定文字(数字)で行挿入、挿入された行で合計したい 2 2023/03/13 14:30
- Excel(エクセル) Excel 特定セルの数値を参照したセルの0表示が空白にならないのはどうしてか? 3 2022/04/28 22:23
- Excel(エクセル) エクセルの数式について教えて下さい。 8 2023/05/27 12:17
- Excel(エクセル) 非表示にしたい行をグループ化して折り畳み 4 2022/09/17 20:17
- Excel(エクセル) マクロだと数式が表示される 2 2022/09/10 14:48
- Excel(エクセル) Excel処理について、教えて下さい。 下記表は、サンプルです。(実際には千件以上あります) A列に 6 2023/03/16 18:21
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル マクロ オートフィ...
-
[EXCEL]ボタン押す→時刻が表に...
-
【Excel関数】UNIQUE関数で"0"...
-
エクセルで特定の文字列が入っ...
-
エクセルマクロで偶数行(又は...
-
電話番号の入力方式が違うデー...
-
エクセルVBA 最終行を選んで並...
-
エクセル 上下で列幅を変えるには
-
Excel 時刻の並び替え
-
エクセルのマクロで意図しない...
-
Excel2007で、指定範囲の行高さ...
-
EXCELで最後の行を固定
-
結合されたセルをプルダウンの...
-
エクセル マクロで数値が変っ...
-
Excel ウインドウ枠の固定をす...
-
AのセルとB行を比較して、一致...
-
Excel グラフのプロットからデ...
-
エクセルVBAのEntireRow.Hidden...
-
EXCEL 「最後のセル」のリセット
-
エクセルVBA:リストに登録した...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
結合されたセルをプルダウンの...
-
[EXCEL]ボタン押す→時刻が表に...
-
excel 小さすぎて見えないセル...
-
AのセルとB行を比較して、一致...
-
エクセル マクロで数値が変っ...
-
エクセル 上下で列幅を変えるには
-
excelのデータで色つき行の抽出...
-
Excel グラフのプロットからデ...
-
エクセル2016で時間を入力して...
-
VBAで色の付いているセルの行削除
-
特定の文字がある行以外を削除...
-
連続データが入った行の一番右...
-
エクセルVBA 最終行を選んで並...
-
エクセルのセルに指定画像(.jpg...
-
エクセルで昨日までの日付デー...
-
エクセルマクロで偶数行(又は...
-
A1に入力された文字列と同じ文...
おすすめ情報