We will be migrating from Ask to Discourse on the first week of August, read the details here

質問する
0

条件に合った行を削除するマクロについて

質問日 2021-05-31 08:57:51 +0200

92 のGravatar画像

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

edit retag flag offensive close merge delete

Comments

1 Answer

2

回答日 2021-06-05 14:23:52 +0200

KWatanabe のGravatar画像

updated 2021-06-06 02:46:17 +0200

このマクロがマイマクロにセットできるかどうか確認していません。

マクロの内容は「指定した列内のセル値を検索し、セル値が検索指定値と同じ場合は該当行を削除する」というもので

処理手順は

・データのA列でデータ件数を調査し繰り返し処理用の変数にセット

・For文を使って検索値を検索

・条件に合致した場合は該当行を削除する処理をCall文で呼び出す

・条件に合致するデータを見つけ次第、該当行を削除します。

この処理で利用する下の2つはJA福岡市HP(https://www.ja-fukuoka.or.jp/libre/)「ExceltoCalcマクロ移行マニュアル」の公開情報を利用して作成しCall文として呼び出しています。

※データ件数を取得する処理 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福岡市マニュアル掲載のプロシージャ ****

'https://www.ja-fukuoka.or.jp/libre/

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
edit flag offensive delete link もっと
ログイン/サインアップして回答する

質問ツール

1 follower

Stats

Asked: 2021-05-31 08:57:51 +0200

Seen: 130 times

Last updated: Jun 06