マクロの行削除の記述の仕方

質問

ＡＩ列の６行目からデータが入っています。
ＡＩ列にk000000が入っている行をすべて削除したい。
そのマクロの記述の仕方を教えてください

回答No.3

Xen · ベストアンサー

AI列のデータが空セルなど無く連続してるのかで変わりますが、連続してるのであれば単純に以下でいいかもしれません。

Sub Delete_Row()

　Range("AI6").Activate
　Do While ActiveCell.Text <> ""
　　If ActiveCell.Text = "k000000" Then
　　　Selection.EntireRow.Delete
　　Else
　　　ActiveCell.Offset(1, 0).Activate
　　End If
　Loop

End Sub

その他の条件があるなら上記をカスタマイズしてみて下さい。

回答No.2

noname#79209

どうしてもマクロでなくてはいけないのでしょうか？

１回限りのことで良いのなら、マクロではなく以下の方法は如何でしょう。

1. ５行目が列タイトルであれば、AI5（5行目のタイトルならどのセルでも良い）をアクティブセルにする。
2. 「データ」->「フィルタ」->「オートフィルタ」を設定。
3. AI5の「下向きの三角形」をクリックし、「k000000」を選択。
4. 「k000000」が入った行のみが選択されるので、行番号上でドドラッグして「k000000」が入った行を選択。
5. そのまま、「編集」->「行の削除」をクリック。

回答No.1

1050 円（@1050YEN）

Option Explicit

Sub 消す()
　　'可変項目
　　'------------------------------------------------
　　Dim xlsシート　　　 As Excel.Worksheet
　　Dim str消対象列　　 As String
　　Dim str消対象文字　 As String
　　Dim int消対象開始列 As Integer

　　Set xlsシート = ThisWorkbook.Worksheets(1)
　　str消対象列 = "AI"
　　str消対象文字 = "k000000"
　　int消対象開始列 = 6
　　'------------------------------------------------

　　Dim rng消す対象エリア　 As Range
　　Dim col消す対象　　　　 As Collection

　　'消す対象となる範囲を取得する
　　Set rng消す対象エリア = 取得_消す対象エリア(xlsシート, str消対象列, int消対象開始列)
　　If (rng消す対象エリア Is Nothing) Then
　　　　Call MsgBox("データが範囲内に存在していない", vbCritical)
　　　　Exit Sub
　　End If

　　'消す対象となるデータのセルを取得する
　　Set col消す対象 = 取得_消す対象(rng消す対象エリア, str消対象文字)
　　If (col消す対象.Count < 1) Then
　　　　Call MsgBox("範囲内に消対象文字列が見つからない", vbCritical)
　　　　Exit Sub
　　End If

　　'実行
　　Call 消す実行(xlsシート, col消す対象)

　　Call MsgBox("終了", vbInformation)
End Sub

Private Sub 消す実行(p_xlsシート As Excel.Worksheet, col消す対象 As Collection)
　　Dim strRows()　 As String
　　Dim strWk　　　 As String
　　Dim intCount　　As Integer
　　Dim i　　　　　 As Integer

　　intCount = col消す対象.Count

　　If (intCount < 1) Then
　　　　Exit Sub
　　End If

　　ReDim strRows(1 To intCount)
　　For i = 1 To intCount
　　　　strWk = col消す対象(i).Row
　　　　strRows(i) = strWk & ":" & strWk
　　Next i

　　p_xlsシート.Range(Join(strRows, ",")).Delete

End Sub

Private Function 取得_消す対象(p_rang消す対象エリア As Range, p_str消対象文字 As String) As Collection
　　Dim rngWk　 As Range
　　Dim colRet　As Collection

　　'返しコレクション初期化
　　Set colRet = New Collection

　　'まず検索する
　　Set rngWk = p_rang消す対象エリア.Find(p_str消対象文字)
　　'見つからない場合は終了
　　If (rngWk Is Nothing) Then
　　　　GoTo PGMEND
　　End If

　　'コレクションに追加
　　colRet.Add rngWk

　　Do
　　　　'次を検索
　　　　Set rngWk = p_rang消す対象エリア.FindNext(rngWk)
　　　　'最初に見つかったものと一緒であれば抜ける
　　　　If (rngWk.Row = colRet(1).Row) Then
　　　　　　Exit Do
　　　　End If

　　　　'コレクションに追加
　　　　colRet.Add rngWk

　　Loop

PGMEND:
　　Set 取得_消す対象 = colRet
End Function

Private Function 取得_消す対象エリア(p_xlsシート As Excel.Worksheet, p_str消対象列 As String, p_int消対象開始列 As Integer) As Range
　　Dim rng最終セル As Range
　　Dim int行　　　 As Integer
　　Dim int列　　　 As Integer

　　'データエリアを得る
　　int列 = p_xlsシート.Cells(1).SpecialCells(xlLastCell).Row
　　int行 = p_xlsシート.Columns(p_str消対象列).Column

　　'開始列まで、データがが存在していない
　　If (int列 < p_int消対象開始列) Then
　　　　Exit Function
　　End If

　　'対象となる範囲を返す
　　With p_xlsシート
　　　　Set 取得_消す対象エリア = .Range(.Cells(p_int消対象開始列, int行), .Cells(int列, int行))
　　End With
End Function