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


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

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

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

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

全て削除される。

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

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2008/12/03 18:36:40
  • 終了:2008/12/06 01:32:29

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/12/03 19:31:48

ポイント100pt

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

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/

id:aiomock

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

2008/12/03 21:27:23

その他の回答(4件)

id:pahoo No.1

pahoo回答回数5960ベストアンサー獲得回数6332008/12/03 19:20:47

ポイント40pt

できます。


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

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 を何度か呼び出してください。


参考サイト

id:aiomock

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

2008/12/04 11:10:25
id:van-dine No.2

van-dine回答回数108ベストアンサー獲得回数112008/12/03 19:30:37

ポイント50pt

下の通りです。

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

id:aiomock

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

2008/12/03 21:27:20
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/12/03 19:31:48ここでベストアンサー

ポイント100pt

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

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/

id:aiomock

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

2008/12/03 21:27:23
id:taknt No.4

きゃづみぃ回答回数13537ベストアンサー獲得回数11982008/12/03 19:38:57

ポイント50pt
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

id:aiomock

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

2008/12/03 21:27:25
id:pahoo No.5

pahoo回答回数5960ベストアンサー獲得回数6332008/12/04 13:11:38

ポイント40pt

#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
id:aiomock

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

2008/12/05 17:47:27
  • id:taknt
    >ご質問主旨が消去(Clear)ではなく行削除(Delete)だったようなので、

    そのわりには 関数名が DeleteMultiple なのは なぜ?
  • id:pahoo
    taknt > そのわりには 関数名が DeleteMultiple なのは なぜ?

    そういうご指摘をいただくと、勘違いとしか返答のしようがなく、面目次第もありません。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません