- ベストアンサー
空白セルがある行の左寄せ操作の件
merlionXXの回答
- merlionXX
- ベストアンサー率48% (1930/4007)
No2-5 merlionXXです。 > Ｍ列以降にデータがある場合があります。 M列までは左に詰めていいんですね？ ならば Sub TEST03() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual x = Range("B1").End(xlDown).Row Set myRng = Range("I1:I" & x).SpecialCells(xlCellTypeBlanks) For Each C In myRng コピー開始列 = C.End(xlToRight).Column Range(Cells(C.Row, コピー開始列), Cells(C.Row, "M")).Cut Cells(C.Row, "I") Next C Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub M列は左に移動させたくないのなら Range(Cells(C.Row, コピー開始列), Cells(C.Row, "M")).Cut を Range(Cells(C.Row, コピー開始列), Cells(C.Row, "L")).Cut に変えてください。
noname#99913
関連するQ&A
- E列が空白のとき、その空白行を削除し、番号を振り直す
windows7 Excel2003でマクロ勉強中です。 あるサイトにE列が空白のとき、その空白行を削除し、番号を振り直すという コードがありました。 自分で作った表（表の最上段の２行は項目名が入っています。）で 実行すると「Rangeメソッドは失敗しました。Globalオブジェクト」と エラーが出ます。エラーはでますが、処理自体は正しく実行されます。 このエラーの原因と回避するにはどうしたらよろしいでしょうか。 Sub E列が空白のとき、その空白行を削除し、番号を振り直す() Dim i As Long, j As Long '行削除の処理 For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then If Range("E" & i).Value = "" Then Rows(i).Delete End If End If Next '番号振りなおし処理 '’’Range("A" & Rows.Count).End(xlUp).Offset(1).Select For i = 0 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & i).Value = "番号" Then j = 1 ・・・・・ここでエラー発生 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then Range("A" & i).Value = j j = j + 1 End If Next ActiveSheet.Protect End Sub
- ベストアンサー
- Visual Basic
- 途中に空白行や列があるデータ範囲
エクセル2003です。 セルA1からセルC50までデータがあり 10行目と20行目は全て空白、 セルC39が空白で セルE55、F57、G55にはデータがある の状態で以下の構文ですと Sub 範囲コピー1() Range("B3").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy End Sub 途中に空白行や列、空白セルがあり さらに離れた所E55、F57、G55に データが有るのにもかかわらず セルB3からセルG57までを選択してクリップボードにコピー してくれます。 ですが問題がありまして 上記のシートにて A45～F50を選択してDeleteをし、 さらにセルのF55、G55もDeleteして データ範囲を セルA1～E44とセルE55のみにしてからから 上記構文を実行すると セルB3からセルE55を選択してクリップボードにコピー してほしいのに、 データ削除前と同様の セルB3からセルG57を選択してクリップボードにコピー されてしまいます。 これはエクセルの手操作 Ctrl＋Shift＋End でも同じようになりますので当然の結果(※１）と思っています。 （※１→なにか別な方法はありますか？） 上記の使用方法はあまりないのですが 構文を使う時点での最大行数や最大列数は常に不明で 途中空白が有る場合無い場合、 上記のようにシート上でデータ操作をした直後であっても データ削除部分は加味しデータのある範囲だけの取得の対応 が可能な構文を1種類で作成したいのですが どういう方法があるでしょうか？ ちなみに Sub 範囲コピー2() Range("B3").Select Range(Cells(Rows.Count, 1).End(xlUp).Row).Select Range(Cells(1, Columns.Count).End(xlToLeft).Column).Select Selection.Copy End Sub これですと 実行時エラー1004 Rangeメソッドは失敗しましたGlobalオブジェクト となります。 ヘルプをクリックしても何も表示されません。 WEB検索するとこのエラーの質問は結構多いのですが 事例が相違する為よく理解できません。 もしかしてRangeなのに 取得できる値が一つの番号でセルを指定できないからでしょうか？ エラーになる構文だと最初のRangeは行番号、次のRangeは列番号、 ですので。 で、 Sub 範囲コピー3() Dim 最終行 Dim 最終列 Range("B3").Select 最終行 = Cells(Rows.Count, 1).End(xlUp).Row 最終列 = Cells(1, Columns.Count).End(xlToLeft).Column Cells(最終行, 最終列).Select Selection.Copy End Sub これならエラーにはなりませんが 事例だとセルC50だけが単独選択されて範囲として 取得をしてくれません。 また 1, Columns.Count ですので最終列の列番号の取得が1行目の最終列から左に検索し データのある所の列番号を返すので 3→C列 となってしまい D,E,F列を見つけてくれません。 かといって 55, Columns.Count では データが55行まで無い場合には対応が出来ませんのでこれも駄目です。 途中に空白が無い場合や離れたセルが無い場合でも使いたいので UsedRangeは使用したくない（よくわかってない事もあって）です。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 空白のセルを行削除する。EXCELマクロなのですが・・
VBA初心者です。 データーをHPから、単純にコピーしてきて、 EXCELに貼り付けています。 フィルターをかけても、画像かなにかがセルに張り付いているのか、 空白行をすべて削除できません。 いろいろ試して（HPから、空白セルの行削除について書かれてあるマクロを貼り付けて）動いたのが、このVBAです。 しかし、遅いので、早いVBAに簡略できればいいのですが。。 大体、1000行ぐらいの文字を貼り付けて、3/1ぐらいが空白行です。A行のセルの空白のみを、削除したいのですが。 まったくの素人なので、わかりません。 どうかよろしくお願いいたします。 Sub 空白の削除() x% = Worksheets("sheet1").Range("A65536").End(xlUp).Row For i = x% To 1 Step -1 If Worksheets("sheet1").Cells(i, 1).Value = "" Then Worksheets("sheet1").Rows(i).Delete Next End Sub
- ベストアンサー
- オフィス系ソフト
- Excelvba表に空白行があれば上に詰める重い
いつもお世話になっております。 列がD列からK列で、行が4行目から23行までの表があります。 その表で1行まるまる空白の時（4行目にには数式が入っていますがそれは除く） 上の行に詰めるようにしてあります。行はそのまま空白のまま残して、値のみ上に詰めるようにしています。 このような表が同じ列に4か所×3＝12か所あるので、今はそれぞれ下のコードの行、列を変更して処理しています。 上の表と下のの表の間隔は、上が４～23行までで、下は30～49、と6行間隔です。結合セルも間にあるため5行空きがあります。 列と列の間隔は、左側から、D列～K列、続いて、N列～U列と続きます。2列空きがあります。 家で試した時は一応問題なく動いたのですが、 会社でした時フリーズしてしまい、うまくいきませんでした。 その後、家でしてもなぜかうまく動作しなくなりました。 １２の表は多いのかと思い、1つで試してもだめになりました。 同じような作りの別のファイルは動いています。 念のため、新しいファイルにコピーし直してやりましたが、駄目でした。 コードもあまり良くないのかもしれません。 一応家ではVISTAの2007で試し、会社は7(32ビット)の2013です。 もう少し負担が少なくなるようなやり方があればと思っています。 もう少し、いいやり方があればお手数ですが、ご教授ください。 よろしくお願いいたします。 Sub 表の空白行は上に詰める() Dim i As Integer, x As Integer, y As Integer, CSUM As Integer Dim flag As Boolean Application.ScreenUpdating = False flag = 0 '1回だけの処理で使うフラグ For x = 22 To 4 Step -1 '23行→4行まで処理をします。 CSUM = 0 '列の文字数を数える変数CSUMを用意し、初期値0とします。 For y = 4 To 11 'D列→K列まで処理をします。 CSUM = CSUM + Len(Cells(x, y)) 'CSUMにセル（x,y）の文字数を足します。 Next '列処理繰り返し If CSUM = 0 Then Range(Cells(x + 1, 4), Cells(23, 11)).Copy '空白行の1行下から23行目までをコピー Cells(x, 4).PasteSpecial '空白行の1列目のセルを基点として貼り付け If flag = 0 Then '23行目の値クリア処理 1回だけの処理 Cells(23, 5) = 1 '23行目がすっからかんのときエラーになるので、暫定入力 Range(Cells(23, 4), Cells(23, 11)).SpecialCells(xlCellTypeConstants).ClearContents End If '1回だけの処理 ここまで flag = 1 '1回だけの処理させないためフラグ値変更 End If Application.CutCopyMode = False Next '行処理繰り返し End Sub
- ベストアンサー
- Excel（エクセル）
- vba 対象セルが空白の間動作を繰り返すには？
下記を走らせると、セルが右端まで行ってとまります。 そうなる前に、対象セル範囲が空白になった時点で、動作を止めたいのですが どう記述するのがいいでしょうか？ Dim u As Integer, o As Integer Application.Calculate For u = 2 To 3 For o = 7 To 2000 If Cells(u, o) = "" Then Range("G2").Select Range("G2").End(xlToRight).Select ActiveCell.Resize(6, 5).Select Selection.Cut Range("B2").Select Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste End If Next o Next u End Sub
- ベストアンサー
- Visual Basic
- VBAで空白行を削除する
VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2～AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。
- 締切済み
- Excel（エクセル）
- VBAエクセル空白セル0の入力
C列が空白となるまで、F列・・・L列の空白セルに0を代入する。 という処理を行いたく以下コードで実行をして ファイル種類をCSVにて、保存した後名前の変更で拡張子をTXTにすると データ入力された列の以降がカンマの羅列が「,,,,,,,,(改行)」の繰り返しで表示されてしまいます。 (CSV保存の後、視覚的に空白部分を行選択して削除するとなくなります。) どうすれば、このカンマが表示されなくなるでしょうか。 うまく説明できてないですが、アドバイス御願いします。 Dim i As Long i = 3 Do Until Cells(i, 3).Value = "" If Cells(i, 6).Value = "" Then Cells(i, 6).Value = "0" End If If Cells(i, 7).Value = "" Then Cells(i, 7).Value = "0" End If If Cells(i, 8).Value = "" Then Cells(i, 8).Value = "0" End If If Cells(i, 9).Value = "" Then Cells(i, 9).Value = "0" End If If Cells(i, 10).Value = "" Then Cells(i, 10).Value = "0" End If If Cells(i, 11).Value = "" Then Cells(i, 11).Value = "0" End If If Cells(i, 12).Value = "" Then Cells(i, 12).Value = "0" End If i = i + 1 Loop
- 締切済み
- Visual Basic
- ある列の計算式が入っているセルの行のみを削除したい
Excel2007でマクロを作成している超初心者です。 B列のセルには 空白 文字列 計算式が入っています。このうち計算式の入っているセルの行のみを削除したいのですが、どうしたらよろしいでしょうか？ セルには =IF(C17="","",+K17*L17)という式が入っています。 次式は0か空白の場合ですが、これをどのように修正したらできるでしょうか？ Sub 行の削除() Dim i As Long For i = 1 To Selection.End(xlDown).Columns Step 1 Select Case Range("B" & i).Value Case 0, "" Columns(i).Delete End Select Next End Sub
- ベストアンサー
- Visual Basic
- セル範囲の指定方法について教えて下さい
エクセルマクロ勉強中です。 いつも皆様のご回答をもとに勉強させて頂いております。 下記を行いたいのですが、うまくいきません。 AA列を検索（AA1から最終セルまでは空白セル無し）し、AA1からAEまでをコピー したいです。AEの最終行はAAで検索した最終行となります。 AA10が最終行であったならば、コピー範囲はRange("AA1：AE10")。 AA AD AE 1 1 0 空白 2 1.5 2 空白 3 2 4 0.0 4 2.5 6 0.0 ・ ・ ・ ・ ・ ・ ・ ・ 11 空白 Range("AA1", Range("AA1").End(xlDown).End(xlToRight)).Select Selection.Copy 上記ですとAD列までは選択されますが、AEまで列までを選択するには どうしたらよいのでしょうか？ ご教示頂きたく宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- VBAのセル空白探しは？？？？？？多々仕様なども含めて迷っている部分があるので助けてください
VBAで入力チェッカーを作っているのですが、仕様の部分でなやんでいます。 Private Sub CommandButton1_Click() Dim i As Long lastRow = Range("A65536").End(xlUp).Row For i = 10 To lastRow If Range("A" & i).Value = "" Then Range("A" & i).Value = ??? Exit For End If Next i End Sub USERがあるセルにデータを入力するとA列に５行ごと自動に値が入ります。 しかし、入力忘れで５行飛ばしたりはたまた１０行空白が出来る場合があります。 その際のチェッカーの役割なのですが。。。 したから行を見ていってA１０～最終行までの間でどこか空白があったら下から空白を探し空白箇所から5個上のセルの値を基本的にコピーをしていれる。 もし5個上のセルにも無かったら10個上みたいにやりたいのですがどうしたらよいでしょうか？
- ベストアンサー
- Visual Basic
お礼
merlionXXさん できました。 速度も1/4になりました。 今回不愉快な思いさせてしまい申し訳ありませんでした。 気をつけます。 ありがとうございました。