利用規約の変更について

エクセル2013です。
以下の行削除マクロを作りました。
取得した
最終行が20行目として
最終列がZ列として
セル Z20 の値が
1以上なら問題なく動作するのですが
セル Z20 の値が 0 だとループして終了しません。
どこを修正しても、思うように動作しません。
どこを修正すれば、いいのでしょうか?
よろしくお願いします。


Sub 行削除()

Dim 最終行
Dim 最終列
Dim 対象行

最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得
最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得

Application.ScreenUpdating = False '画面切替停止

For 対象行 = 10 To 最終行
If Cells(対象行, 最終列) = 0 Then
Rows(対象行).Delete
最終行 = 最終行 - 1 '削除により最終行が1行減ったので最終行の値を1行減らす
対象行 = 対象行 - 1 '削除により対象行が1行繰り上がったので対象行の値を1行減らす
Else
End If
Next 対象行
Application.ScreenUpdating = True '画面切替停止解除

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (3件)

Z20??



とりあえず、上手くいかない場合F8で1行ずつ、数値の流れを見ていってください。

対象行が最終行より大きい場合とか (対象行=10 最終行=8)
特に考えなくていいんでしょうか?

対象行を増やして、最終行までいけば終了とForループを組んでいるのに
Forループのなかで、最終行と対象行をマイナスしてます。
ループするのは当たり前な気がします。

やりたいことはいまいち分かりませんが、
このプログラムの場合、最終行から削除していったほうが良いと思います。
(そうすれば、最終行-1、対象行-1をする必要は無くなる為)

この回答への補足

>とりあえず、上手くいかない場合F8で1行ずつ、
>数値の流れを見ていってください。

はい。それでやって、つまづきました。
実験したデータは
A列からZ列、8行目から20行目まで
すべてのセルに値が有ります。
8行目が各列の先頭データなので、8行目の最終列を取得
でそれがZ列。
A列の最終行は20行目。
セルZ8からZ20までを上から順に見ていき
値が0だったらその行は行削除です。
マクロを走らせる前のZ列の最終行であるセルZ20の
値が1とか2とかなら、終了したのに
セルZ20の値が0の場合ははまり込んでしまい
F8で調べて1行づつ調べていったら、
Z列で値が有る最後の行20行目(F8でたどり着いた時は、
すでに数行削除されて14行目になっている)
の値が0だから行削除されます。
すると、最終行と対象行の値が思っている物と違い
ループするのがわかりました。
いくら考えても成り立たないので質問しました。
申し訳ありません。

補足日時:2014/07/28 19:37
    • good
    • 0
この回答へのお礼

おもいだしました。
行削除は最終行から上でした。
ありがとうございます。

お礼日時:2014/07/28 19:38

最終行を取得した後、一旦For Nextループが始まると、いくら最終行を変更しても、ループの終着点は変わりません。

対象行は変更可能です。
    • good
    • 1
この回答へのお礼

はい。f8で調べてそれがわかりました。
ありがとうございます。

お礼日時:2014/07/30 21:13

こんばんは!


No.1さんが仰っているように行(列)削除・挿入の場合は
最終行・最終列から逆に操作するほうが一般的です。

お示しのコードに手を加えるとすると

Sub 行削除()
Dim 最終行 As Long
Dim 最終列 As Long
Dim 対象行 As Long
最終列 = Cells(8, Columns.Count).End(xlToLeft).Column
最終行 = Cells(Rows.Count, "A").End(xlUp).Row
For 対象行 = 最終行 To 10 Step -1
If Cells(対象行, 最終列) = 0 Then
Rows(対象行).Delete
End If
Next 対象行
End Sub

こんな感じでしょうか。

※ 余計なお世話かもしれませんが、データ量が極端に多い場合はループさせるとかなりの時間を要しますので
一気に削除する方法の一例です。
尚、8行目は項目行で空白セルがなく最終列まで項目が入っているとします。
(9行目も何らかのデータが入っているとする)

Sub Sample1()
Dim lastRow As Long, lastCol As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
lastCol = Cells(8, Columns.Count).End(xlToLeft).Column
Range("A8").AutoFilter field:=lastCol, Criteria1:=0
On Error Resume Next '←念のため
Rows(10 & ":" & lastRow).SpecialCells(xlCellTypeVisible).Delete
AutoFilterMode = False
End Sub

これでも同様の結果になると思います。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございます。
no.1の方からのアドバイスで
下からというのを思い出し
自力で作成できました。

お礼日時:2014/07/30 21:14

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルである行以下全部を削除する方法

エクセルである行(もしくは列)以下を全部 削除したいのですが、簡単な方法があれば教えてください。選択して削除するにはあまりにも長く、スクロールしているうちに別のところを指定してしまったりして困っております、
MS office 97 を使用しています、

Aベストアンサー

こんにちは

> 列や行を削除しても空白の行がまた、入ってしまうのはどうやればよいのでしょうか?

 列や行を非表示にするのは、いかがでしょうか?
 例えば、11行目以降を非表示にするには以下の手順です。

1.11行目のセルのどれかを選択
2.Ctrl+Shift+↓
3.メニュー[書式]-[行]-[表示しない]

 11行目以降を再び表示させるには、

1.Ctrl+A(または全セル選択ボタンをクリック)
2.メニュー[書式]-[行]-[再表示]

参考URL:http://www2.odn.ne.jp/excel/

Q指定した文字があった場合、その行を削除するマクロが欲しいです

指定した文字があった場合、その行を削除するマクロが欲しいです
Sheet1(Sheet1以外は対象外)のB列に
XYZ
という文字があった場合、その行をすべて削除する
というマクロはどのように作ればいいでしょうか?
お時間ある方アドバイスいただければ幸いです。

Aベストアンサー

手抜きですがこんな感じでどうでしょう。
削除する行が多いなら画面更新を停止した方が良いでしょう。

Sub Sample()
 Sheets("Sheet1").Select
 Do While (True)
  Columns("B:B").Select
  Set mySelect = Selection.Find(What:="XYZ")
  If mySelect Is Nothing Then Exit Do
  Rows(mySelect.Row).Select
  Selection.Delete Shift:=xlUp
 Loop
End Sub

Qエクセルで特定の行を削除したいのですが。

エクセルで特定の行を一発で削除したいのですが、やり方がわかりません。
どなたか詳しい方お教えいただけませんでしょうか?

やりたいことは、B列に、特定の文字が有れば、その行全部を削除して上方向にシフトしていきたいのですが、マクロとかを使うのでしょうか?
宜しくお願いいたします。

Aベストアンサー

マクロを使う別の方法です。
XXXの部分を特定の文字に置きかえて実行してください。
また、「特定の文字があれば」というのが、その文字列を含む、というのでなくセルの値がその文字列ならば、というのであれば、LookAt:=xlPart の部分を LookAt:=xlWhole に書き換えてください。

Sub DelLines()
  Dim R As Range
  Do
    Set R = ActiveSheet.Range("B:B").Find(What:="XXX", LookAt:=xlPart)
    If R Is Nothing Then Exit Sub
    R.EntireRow.Delete
  Loop
End Sub

QVBAで複数の数式セルを最終行までコピーするには?

エクセルで下記のような表を作成しています。

   A   B   C   D
1 項目1 数式 数式 数式
2 項目2
3 項目3
  ・
  ・
  ・

B1~D1の数式は項目1を参照したものです。
この時、2行目以下~最終行まで数式をコピーするには、
どのようなVBAを書けばよいでしょうか?

よろしくお願い致します。

Aベストアンサー

Range("A1", Cells(Rows.Count, 1).End(xlUp)).Offset(, 1).Resize(, 3).Formula = Range("B1:D1").Formula

とか?

QExcelのVBAで最終行の下にコピーする方法

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の表から同じように転記する場合、
どうコード変わるかも教えていただけましたら助かります。

自分では、下記のようなコードしか書けませんでした。
転記先の表は30列程度になる予定ですので、
出来ればシンプルなコードを教えていただきたいです。


Sub コピー()

Range("B2").Select
Selection.Copy
Range("G2").End(xlUp).Offset(1).Select
ActiveSheet.Paste

End sub


分かりづらい説明かと思いますが、
よろしくお願いします。

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の...続きを読む

Aベストアンサー

その程度の転写なら、あんまりカッコつけてやろうとせずに1個ずつ順番に転記してった方が、シンプルで間違いもありません。

sub macro1()
 dim h as range
 dim c as long
 dim LastRow as long

’貼り付け先行
 lastrow = worksheets("Sheet2").range("G65536").end(xlup).offset(1).row
’貼り付け先列
 c = 7 ’G列

 for each h in worksheets("Sheet1").range("B2:D6") ’コピー元
  worksheets("Sheet2").cells(lastrow, c).value = h.value
  c = c + 1 ’右の列に
 next
end sub

QExcelで空白行を削除するマクロは?

マウスやキーボードを使った記録式でマクロを作っています。
その中でシート上に散らばっている数十行の空白行を削除する行程が必要です。

しかし、マウスやキーに依るメニューでは「空白行の削除」と言うのが有りません。
VBEに直接打ち込まないといけない様です。
ステートメントが分かる方が要らしたら教えてください。

Aベストアンサー

VBAの質問としてお受けします。

>ステートメントが分かる方が要らしたら教えてください
まず、最初に、VBAでは、ステートメントというのは別の意味です。

>しかし、マウスやキーに依るメニューでは「空白行の削除」と言うのが有りません。
マウスのメニューに加えるということでしょうか?
以下は、その行の全てのセルが空白の場合にのみ、削除されます。

'標準モジュールへ
Sub BlankRowsDelete()
 Dim Rng As Range
 Dim i As Long
 Set Rng = Selection '最初にマウスで範囲を選択
 For i = Rng.Rows.Count To 1 Step -1
  With Rng.Cells(i, 1)
   If Application.CountA(.EntireRow) = 0 Then
    .EntireRow.Delete
   End If
  End With
 Next i
End Sub

'標準モジュールか、ThisWorkbook へ
Sub MouseRightClickMenuAdd()
On Error Resume Next
 Application.CommandBars("CELL").Controls("ブランク行削除").Delete
On Error GoTo 0
 With Application.CommandBars("CELL").Controls.Add _
 (Type:=msoControlButton, Temporary:=True)
 .BeginGroup = True
 .Caption = "ブランク行削除"
 .OnAction = "BlankRowsDelete"
 End With
End Sub

'ThisWorkbookへ
Private Sub Workbook_Open()
Call MouseRightClickMenuAdd
End Sub

なお、右クリックメニューでトラブルがあった時は、
 Application.CommandBars("CELL").Reset
を実行してください。通常、Excelを終了すれば、右クリックメニューは解除されます。

VBAの質問としてお受けします。

>ステートメントが分かる方が要らしたら教えてください
まず、最初に、VBAでは、ステートメントというのは別の意味です。

>しかし、マウスやキーに依るメニューでは「空白行の削除」と言うのが有りません。
マウスのメニューに加えるということでしょうか?
以下は、その行の全てのセルが空白の場合にのみ、削除されます。

'標準モジュールへ
Sub BlankRowsDelete()
 Dim Rng As Range
 Dim i As Long
 Set Rng = Selection '最初にマウスで範囲を選択
 For...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QエクセルVBAでフィルタ抽出部分のみのコピー

エクセルVBAで売上帳を作成していますが、オートフィルタでデータ抽出した後、表示されている行のみをコピーして別シートに貼りつけるにはどうすればよいのでしょう?

別シートは指定したセルに値のみの貼り付けをしたいと思っています。

宜しくお願いします。

Aベストアンサー

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペースト
 ActiveSheet.Paste
 'コピー元シートに戻りコピー状態解除
 Sheets("Sheet1").Select
 Application.CutCopyMode = False
 Range("A1").Select
End Sub

外してたら、ごめんなさい

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペース...続きを読む

Qエクセル マクロ オートフィルの終点の指定について

こんにちは。マクロ初心者です。
早速ですがやりたい事を書きます!

A B C
1 名前 住所 TEL
2 あ  い
3 う  え
4 お  か

100 き  く
上記のような状態で、C2セルにある関数(実際にはvlookupです)
を入力し、オートフィルをC2からC100にかけたいです。
ただ、行数は毎回変化するので、AutoFill Destination は
固定ではなく、CurrentRegion の最終行までとしたいです。
どう記述すればよろしいでしょうか?

教えていただけましたら非常にうれしいです。
何卒よろしくお願いいたします。

Aベストアンサー

Range("c2").AutoFill Destination:=Range("C2:C" & Cells(3).CurrentRegion.Rows.Count)

でいかがでしょう。
途中で空白がある場合
Range("c2").AutoFill Destination:=Range("C2:C" & Range("C65536").End(xlUp).Row)

がいいでしょう

Qエクセル:マクロ「Application.CutCopyMode = False」って?

エクセルのマクロを記録していると

「Application.CutCopyMode = False」

というものがよく出てきますが、これは何でしょう?
どういう意味のものかわかりません。
削除しても差し支えないのもでしょうか?

Aベストアンサー

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
Range("A1").Select
Selection.Copy
Range("A2").Select
Application.CutCopyMode = False
ActiveSheet.Paste ← ココでエラー
------------
ご自分で、セルをコピーしてみると分かると思いますが、コピーした範囲が点線で点滅されます。
「Application.CutCopyMode = False」をすると、
その点滅がなくなります。

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
...続きを読む


人気Q&Aランキング

おすすめ情報