中小企業の働き方改革をサポート>>

エクセル2010を使用しております。

初歩の質問になってしまいますが回答よろしくお願いいたします。

A行にデータが約1000件入っていて、これを4行ずつ削除したいと思っています。
形としては最終行から不要な4行(セルに入っている文字数字はランダムです)
を削除して2列上に動いて、A2まで削除したら止まる
でいいと思っているのですが、複数行指定から躓いております。
よろしければコードを教えて頂けませんかお願い致します。

方法がわからない現在は現在は2~5行指定デリート 7~10指定デリート… で手動でやっております(汗)

  A
1  必要
2   不要
3   不要
4   不要
5   不要
6  必要
7   不要
8   不要
9   不要
10  不要
11 必要



726 必要
727  不要
728  不要
729  不要
730  不要
731 必要
732  不要
733  不要
734  不要
735  不要

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

A 回答 (4件)

今の操作を具体化すれば


2~5行目を削除
3~6行目を削除
の繰り返しですよね

ならば
Sub ボタン1_Click()
i = 2
Do While Range("A" & i).Value <> ""
Rows(i & ":" & i + 3).Delete Shift:=xlUp
i = i + 1
Loop
End Sub
でよろしいかと
    • good
    • 0
この回答へのお礼

ありがとうございます。
やりたいことがスマートにできました。

お礼日時:2014/10/24 22:02

>現在は2~5行指定デリート 7~10指定デリート… で手動でやっております(汗)



「実際に」行っているのはそうじゃないことを、実際にエクセルを触ってもう一度ご自分の目と手で確認してください。
で、それをマクロにすると、大体こんな感じになります。

sub macro1()
 dim r as long
 r = 2
 do until cells(r, "A") = ""
  rows(r & ":" & r+3).delete shift:=xlshiftup
  r = r + 1
 loop
end sub
    • good
    • 0
この回答へのお礼

ご回答有難うございます。
こちらの記載は最初の方と似てる形になっているのですが、エクセルの動きをマクロにしたという形でしょうか。
こちらもやりたい形になっていて参考になりました。

お礼日時:2014/10/24 22:05

1000行程度ならこんな感じで良いかと。


行数が、5で割ると1余る行のみ残して削除しています。
なお、削除は1行づつやってます。

Sub Sample()
  Application.ScreenUpdating = False
  nLast = Range("A1").End(xlDown).Row
  For nRow = nLast To 2 Step -1
    If nRow Mod 5 <> 1 Then Cells(nRow, 1).Delete Shift:=xlUp
  Next nRow
  Application.ScreenUpdating = True
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
A列にという私の記載が悪かったのですが知りたいのは行の削除でした。
こちらの記載に関しても今後の参考にさせていただきます。

お礼日時:2014/10/24 21:41

こんにちは!



データの最終行から4行削除 → 5行目を残しその2行上から4行を削除・・・
の繰り返しだとすると

Sub Sample1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 5 Step -5
Rows(i - 3 & ":" & i).Delete
Next i
End Sub

こんな感じではどうでしょうか?

※ データ数は必ず5の倍数になっているという前提です。m(_ _)m
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
前提条件があるのですね。

お礼日時:2014/10/24 22:01

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

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

このQ&Aを見た人はこんなQ&Aも見ています

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

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

QVBA、Excelにて複数行をまとめて削除したいのですが

Dim gyou1 As Range, gyou2 As Range

gyou1 = 4
gyou2 = 62

For data = 1 To 1440

Rows("gyou1:gyou2").Select
Selection.Delete Shift:=xlUp

gyou1 = gyou1 + 1
gyou2 = gyou2 + 1

Next data

複数行をまとめて削除したいのですが、型が一致しないとのエラーで上手く実行できません。
どうすればいいでしょうか?

Aベストアンサー

> Dim gyou1 As Range, gyou2 As Range
> gyou1 = 4
> gyou2 = 62

変数の宣言がおかしいのでは?

> Rows("gyou1:gyou2").Select

変数は""でくくってはダメです。
Rows(gyou1 & ":" & gyou2).Select

QVBA 複数の行を高速で削除する方法

以前、質問で複数の行をRangeに格納し一括で削除する方法を教えていただきました。
実践したコードが以下の通りです。
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Unionで指定の行を複数格納
For i = TergetSetSheets.Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = TergetSetSheets.Rows(i - p)
Else
Set SetRan = Union(SetRan, TergetSetSheets.Rows(i - p))
End If
Next
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
500行くらいなら0.03秒くらいで処理できていたのですが、
4700行で6.8秒、9400行で52秒になりました。
※描写は停止にしています。
これ以上早く処理を行うことはできるのでしょうか?
なるべくなら行の削除を行いたいと思っています。
なぜなら表の集計をこの後に行うのにあらかじめ不要な行を先に削除しておくことにより
処理速度が上がるのではないかと思っているからです。

いい方法がありましたら知恵を貸してください。
どうかよろしくお願いいたします。

以前、質問で複数の行をRangeに格納し一括で削除する方法を教えていただきました。
実践したコードが以下の通りです。
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Unionで指定の行を複数格納
For i = TergetSetSheets.Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = TergetSetSheets.Rows(i - p)
Else
Set SetRan = Union(SetRan, TergetSetShee...続きを読む

Aベストアンサー

まず現行マクロの改良としては、「オブジェクトに触る回数を少なくする」
TergetSetSheetsこれはワークシートだと思いますが、ループ内で9000行処理するなら9000回同じシート名を指定することになり、低速化の原因になります。下記のようにすると指定が省略されて速く、しかも見た目スッキリで可読性が上がります。
With TergetSetSheets
For i = .Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = .Rows(i - p)
Else
Set SetRan = Union(SetRan, .Rows(i - p))
End If
Next
End With

SetRanはセルではなく行のようですね。遅くなりませんか?1セルだけであっても、一括削除する際にEntireRowとすれば行になりますよ。この比較は私もしたことがないので、確信持っては言えませんが。

次に、削除せず残す方に規則性があるなら、Autofilterを使う方法があります。マクロでなく通常の手動操作でもフィルタがありますが、あれです。あれで削除する行「以外」が表示されるようにして、全選択→コピー→別シートにペースト これでも速いです。これを考えると、手動でもいいんじゃないの?とか藪蛇な思いがあります(笑)

Union の後で一括deleteもAutofilterもそうですが、エクセルでは一気に選択、一気に処理するのが速いです。乱暴に言うと一行ステートメントで「一括処理」するのが速いのです。その意味ではFor Nextループは一回ずつ順番に9000回処理するため、低速化の一因になります。しかし今回の場合、やらない訳には行きませんので残してます。

老婆心ながら、エクセルVBAの質問なら、カテゴリはVisual Basicまたはエクセルが良いです。

まず現行マクロの改良としては、「オブジェクトに触る回数を少なくする」
TergetSetSheetsこれはワークシートだと思いますが、ループ内で9000行処理するなら9000回同じシート名を指定することになり、低速化の原因になります。下記のようにすると指定が省略されて速く、しかも見た目スッキリで可読性が上がります。
With TergetSetSheets
For i = .Range("Y" & Rows.Count).End(xlUp).Row To 7 Step -7
If SetRan Is Nothing Then
Set SetRan = .Rows(i - p)
Else
Set SetRan = Union(SetRan, .Rows(i - p)...続きを読む

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変数を用いて行全体を削除するには。

エクセル上で変数を用いた行全体の削除を行うマクロを組みたいと思っております。
具体的に言えば、
Range("2:16").EntireRow.Delete とすれば、2行目から16行目までを
削除するという意味になりますが、ここの「2」及び「16」の箇所を
InputBox関数で変数化したいのです。
なにぶんにも初心者ですので、舌足らずの部分があると思いますが、
なにとぞご教授くださいますようお願いいたします。

Aベストアンサー

行全体の選択ですよね
InputBoxの変数が
GYOUST、GYOUENDとして
Rows(GYOUST & ":" & GYOUEND).EntireRow.Delete
と入れてみてください。

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

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

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QVBAで文字列を数値に変換したい

A列とE列の文字列になってしまった数値を
数値に変換したく、以下のようなものを作ったのですが、
文字の無いセルまで、数値に変換しようとするので
時間がかなりかかります。
何かよい方法は無いでしょうか?
よろしくお願いいたします。


Sub 数値に変換()
Range("A:A,E:E").Select
For Each xCell In Selection
xCell.Value = xCell.Value
Next xCell
End Sub

使用ソフトEXCEL2000orEXCEL2003

Aベストアンサー

>Range("A:A", "E:E")
これは、A、B,C,D,E列のことなので
A列とE列であれば質問者のようにRange("A:A,E:E")です。

ま、それはそれとして、回答。

Sub Test()
 Range("A:A").Value = Range("A:A").Value
 Range("E:E").Value = Range("E:E").Value
End Sub

以上。
 

QVBAで行コピーして挿入

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).Select
  Selection.Insert Shift:=xlDown
  Selection.EntireRow.Hidden = False
Next i

どういう結果を求めたいかというと、たとえば、
SHEET2のA10セル上で、このマクロを実行し、 "挿入行 = 3" と指定したら

A10:   =SHEET1!$A10
A11:   =SHEET1!$A11
A12:   =SHEET1!$A12

となってほしかったのですが、結果は、

A10:   =SHEET1!$A10
A11:   =SHEET1!$A10
A12:   =SHEET1!$A10

となってしまいました。

どうにか、求める結果を得られるようにできないでしょうか?

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).S...続きを読む

Aベストアンサー

Active.Cellが同一の位置なのだから相対変位しません。

一例です。(ループは不要なので削除しました)
myR = Application.InputBox("挿入する行数を入れてください", , "1")
Rows("1:1").Copy
Rows(ActiveCell.Row & ":" & ActiveCell.Row + myR - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False


人気Q&Aランキング

おすすめ情報