人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのVBAについて質問です。

(指定した行)と(その行から9の倍数の行のデータ)だけを残したいのですが、

そのようなことは可能でしょうか?

例)10行目から始めた場合、10行目のデータを残し、

19行目のデータ、28行目のデータ、37行目のデータと次々とデータが残り、後の行のデータは

全て削除される。

また、(指定した行)から残す行の倍数を変化させたいのですが、変更の仕方も含めてお願いします。



●質問者: aiomock
●カテゴリ:コンピュータ インターネット
✍キーワード:28 VBA エクセル データ
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● pahoo
●40ポイント

できます。


こんな感じでどうでしょう。

DeleteMultiple(倍数, 開始行, 終了行)

のようにして使います。

Option Explicit

'nの倍数の行を削除する
'引数
' n 倍数
' ln_start 処理開始行番号
' ln_end 処理終了行番号
'戻り値=削除件数
'
Function DeleteMultiple(n As Integer, ln_start As Integer, ln_end As Integer) As Integer
 Dim ln As Integer
 DeleteMultiple = 0
 ln = ln_start
 '最初の行がnの倍数なら削除
 If (ln Mod n = 0) Then
 ActiveSheet.Rows(ln).Select
 Selection.ClearContents
 DeleteMultiple = DeleteMultiple + 1
 End If
 ln = ln + n
 'nの倍数でループ処理
 Do
 ActiveSheet.Rows(ln).Select
 Selection.ClearContents
 ln = ln + n
 DeleteMultiple = DeleteMultiple + 1
 Loop While ln <= ln_end
End Function

Sub Macro1()
 Dim n As Integer
 n = DeleteMultiple(8, 8, 35)
 MsgBox n & "件を削除しました"
End Sub

(指定した行)から残す行の倍数を変化させたいのですが

DeleteMultiple を何度か呼び出してください。


参考サイト

◎質問者からの返答

ご回答ありがとうございます。


2 ● van-dine
●50ポイント

下の通りです。

Dim CurCell As Range

Set CurCell = Application.InputBox(Prompt := "開始セルは?", Type := 8)
Do
 CurCell.Range("2:10").Delete '「2:10」の「10」は「削除したい行数+1」の意
 Set CurCell = CurCell.Range("A2")
Loop Until VarType(CurCell) = vbEmpty

↓ダミー

http://q.hatena.ne.jp/1228296998

◎質問者からの返答

ご回答ありがとうございます。


3 ● SALINGER
●100ポイント ベストアンサー

始めの行はカーソルのある行からにして、倍数はインプットボックスで入力するようにしています。

Sub Macro()
 Dim baisuu As Long
 Dim r As Long
 Dim MaxRow As Long
 Dim i As Long
 Application.ScreenUpdating = False
 baisuu = Application.InputBox(Prompt:="残す行の倍数はいくつですか?", Type:=1)
 If baisuu = False Then Exit Sub
 r = Selection.Row
 MaxRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
 
 For i = r To MaxRow
 Rows(i + 1 & ":" & i + baisuu - 1).Delete
 MaxRow = MaxRow - baisuu + 1
 Next i
 
 Application.ScreenUpdating = True
End Sub

http://q.hatena.ne.jp/

◎質問者からの返答

ご回答ありがとうございます。


4 ● きゃづみぃ
●50ポイント
Sub 削除処理()
指定行数 = 9

開始行 = Selection.Rows


For a = 開始行 + 1 To 65536 - 指定行
 If WorksheetFunction.Count(Range(a & ":" & a)) = 0 Then Exit For
 
 b = a + 指定行数 - 2
 Rows(a & ":" & b).Delete Shift:=xlUp
 
Next a

End Sub

選択しているセルからスタートします。

指定行数 = 9

この値を変更すればいいですよ。


http://www.page.sannet.ne.jp/je3nqy/excel/f_excel.htm

◎質問者からの返答

ご回答ありがとうございます。


5 ● pahoo
●40ポイント

#1で回答した者です。

ご質問主旨が消去(Clear)ではなく行削除(Delete)だったようなので、下記のように訂正します。

Option Explicit

'nの倍数の行を削除する
'引数
' n 倍数
' ln_start 処理開始行番号
' ln_end 処理終了行番号
'戻り値=削除件数
'
Function DeleteMultiple(n As Integer, ln_start As Integer, ln_end As Integer) As Integer
 Dim ln As Integer
 DeleteMultiple = 0
 ln = ln_start
 '最初の行がnの倍数なら削除
 If (ln Mod n = 0) Then
 ActiveSheet.Rows(ln).Select
 Selection.Delete
 ln = ln - 1
 DeleteMultiple = DeleteMultiple + 1
 End If
 ln = ln + n
 'nの倍数でループ処理
 Do
 ActiveSheet.Rows(ln).Select
 Selection.Delete
 ln = ln - 1 + n
 DeleteMultiple = DeleteMultiple + 1
 Loop While ln <= ln_end
End Function

Sub Macro1()
 Dim n As Integer
 n = DeleteMultiple(8, 10, 35)
 MsgBox n & "件を削除しました"
End Sub
◎質問者からの返答

ご回答ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ