Dのセルに●●●があった場合、その行を削除したいです。
マクロをマイマクロに保存したい為、Option VBASupport 1は使うことが出来ません。
basicでのコードを教えていただけませんでしょうか。
Sub DeleteRowIf()
Dim i As Long
For i = Range(“A1”).End(xlDown).Row To 2 Step -1
With Cells(i, “D”)
If _
.Value Like “●●●” Then
.EntireRow.Delete
End If
End With
Next i
End Sub
メモ(当方の時間の都合で未検証)
このマクロがマイマクロにセットできるかどうか確認していません。
マクロの内容は「指定した列内のセル値を検索し、セル値が検索指定値と同じ場合は該当行を削除する」というもので
処理手順は
・データのA列でデータ件数を調査し繰り返し処理用の変数にセット
・For文を使って検索値を検索
・条件に合致した場合は該当行を削除する処理をCall文で呼び出す
・条件に合致するデータを見つけ次第、該当行を削除します。
この処理で利用する下の2つはJA福岡市HP（404 エラー | JA福岡市 福岡市農業協同組合
※データ件数を取得する処理 Search_DEnd
※行・列を削除する処理 RC_sakujyo
RC_sakujyoとSearch_DEndはCall文があるDataselect_deleteと一緒のモジュール内に置いてください。
マクロは以下のように記述しました。
Dataselect_deleteを実行するとA列に検索指定値「DDD」が入っている行は削除されます。
'****************** 共通Public変数宣言 **************
Public End_Row As Long 'データ最終行を格納する共通変数 行数を求める戻り値などに利用しています
'****************************************************
Sub Dataselect_delete()
'*****************************************************************************
'* システム名 :
'* 機能 : 指定された列にあるデータを検索して条件に合致するデータ行を削除する
'* 備考 :
'*****************************************************************************
Dim nColumn As Long '列数
Dim nRow As Long '行数
Dim sField As Variant 'セル値
Dim oSheet As Object
'//シート名を指定**********
Dim Sheetmei As String
Sheetmei = "Sheet1"
'//検索する値を指定**********
Dim Kmoji As Variant
Kmoji = "DDD"
'//指定データ列のレコード数を求めています（プロシージャ呼び出し）
Call Search_DEnd(Sheetmei,0,0) '0=A列データの最終行 ,1=行番号 0=セル番号で返す
'//アクティブシートを取得
oSheet = ThisComponent.CurrentController.ActiveSheet
For nRow = 0 To End_Row '2行目からの場合は 1 to End_Row
nColumn = 0 '0=A列データ
sField = ""
sField = oSheet.getCellByPosition( nColumn, nRow ).getString
If sField = Kmoji then
'//条件に該当する行を削除（サブプロシージャ呼び出し）
Call RC_sakujyo(Sheetmei,nRow,1,1)
End_Row = End_Row - 1 '行削除に合わせて終了行数マイナス
nRow = nRow - 1 '行削除に合わせて処理行数マイナス
End If
Next nRow
End Sub
'********* 以下：参考 JA福岡市マニュアル掲載のプロシージャ *************
'LibreOffice | JA福岡市 福岡市農業協同組合
Sub RC_sakujyo(SheetMei as string,RCNo as integer,Sakujyosu as long,Gyouretukbn as integer)
'*****************************************************************************
'* システム名 :
'* 機能 : 行・列の削除
'* 備考 :
'*****************************************************************************
'* 作成 JAFukuoka) M " 2012.03.09 変更: 2015/08/09
'* 引数内容 ：シート名,削除開始行.列No（1行目＝0、A列＝0）, 削除する行数・列数, 削除する行・列の区分(行＝1・列＝2)
'*呼び出し例:Call RC_sakujyo("シート名",0,5,2) 'シート名シートのA列から5列削除します
'*****************************************************************************
Dim oDoc as Object
Dim oSheet as Object
Dim oRows as Object
Dim oColumns as Object
If Gyouretukbn = 1 then
oDoc=ThisComponent
oSheet=oDoc.Sheets.getByName(SheetMei)
oRows = oSheet.getRows()
oRows.removeByIndex(RCNo,Sakujyosu)
Else
oDoc=ThisComponent
oSheet=oDoc.Sheets.getByName(SheetMei)
oColumns = oSheet.getColumns()
oColumns.removeByIndex(RCNo,Sakujyosu)
End if
End Sub
Sub Search_DEnd(SheetMei as string,Col as integer,Bangoukbn as integer)
'*****************************************************************************
'*
'* 機能 : 指定列データの最終行番号を取得(出力する行番号はセルの行番号とセル位置を選択可)
'* 引数 : シート番号・列番号『（例)A=0』・戻り値番号区分（行番号:1 セル位置:2）
'*****************************************************************************
'* 作成 : JAFukuoka) M " 2012.03.09 変更: 2015/08/09
'* ・queryContentCellsメソッドの引数
'* 1：数値 2：日付と時刻 4：文字列 8：コメント 16：数式 32：セルに直接設定された書式
'* 64：スタイルによる書式（間接書式） 128：図形描画オブジェクト 256：セル内の一部の文字列に設定された書式
'* 呼び出し例: Call Search_DEnd("シート名",0,1) 'シート名のA列にあるデータの最終行を行番号で返す
'*****************************************************************************
Dim oSheet as Object
Dim oColumn as Object
Dim oRanges as Object
Dim iCountRange as long
Dim iRowBottom as long
Dim oRange as Object
oSheet = ThisComponent.Sheets.getByName(SheetMei)
oColumn = oSheet.getColumns().getByIndex(Col)
oRanges = oColumn.queryContentCells(1+2+4+8+16) '(引数：1と2と4と8と16に該当する値が入ったセルを指定している)
' oRanges = oColumn.queryContentCells(31) '(上記引数を合計した値31だけでも同じ動作が可能です)
iCountRange = oRanges.getCount()
If iCountRange = 0 Then 'データがない時は0を返します。
iRowBottom = -1
Else
oRange = oRanges.getByIndex(iCountRange-1 )
iRowBottom = oRange.getRangeAddress().EndRow
End If
If Bangoukbn = 1 then
End_Row = iRowBottom+1 '戻り値：行番号。（A3にデータがあった場合、3を返します）
Else
End_Row = iRowBottom '戻り値：セル指定用行番号。（A3にデータがあった場合、2を返します）
End if
End Sub