お気持ちのみですが完成したら合計で150p差し上げます。

次の簡単なエクセルのマクロを作ってください。


1)B列に"○"かそれ以外の内容が連続して書いてある。
2)B列をアクティブセルの行から上から順番に参照していって、その行について○があったら保持、それ以外だったら列を削除。
3)終了条件=B列に空白セル発見。
4)動作を高速にするために描画を停止しておく。

よろしくお願いします

回答の条件
  • 1人2回まで
  • 登録:2007/05/29 16:22:56
  • 終了:2007/05/31 23:36:57

回答(6件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/05/29 16:34:25

ポイント1pt

Sub Macro2()

'

' Macro2 Macro

'

Dim a As Long

Dim b As Long

For a = 1 To 65536

If Range("B" & a) = "" Then Exit For

Next a


For b = a To 1 Step -1

If Range("B" & b) <> "○" Then Rows(b & ":" & b).Delete Shift:=xlUp

Next b

End Sub

id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/05/29 16:40:01

ポイント75pt

Sub Macro2()

'

' Macro2 Macro

'

Dim a As Long

Dim b As Long

a = ActiveCell.Row

If a = 1 Then End

For b = a - 1 To 1 Step -1

If Range("B" & b) = "" Then Exit For

If Range("B" & b) <> "○" Then Rows(b & ":" & b).Delete Shift:=xlUp

Next b

End Sub

すみません、アクティブセルからでしたね。

id:ReoReo7

ありがとうございます。

2007/05/29 20:12:40
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692007/05/29 18:00:38

ポイント10pt

マクロの1行目に

Application.ScreenUpdating = False

で描画は高速になります。

id:ReoReo7

ありがとうございます。

2007/05/29 20:12:42
id:Mook No.4

Mook回答回数1312ベストアンサー獲得回数3912007/05/29 20:05:30

ポイント40pt

こういうことでしょうか。

Sub DeleteRows()
    Dim cRow As Long
    Dim eRow As Long
    
    '--- アクティブセルが空白だったら終了
    If IsEmpty(Cells(ActiveCell.Row, "B")) Then
        Exit Sub
    End If
    
    '--- 処理対象の最終行を設定
    cRow = ActiveCell.Row
    If IsEmpty(Cells(cRow + 1, "B")) Then
        eRow = cRow
    Else
        eRow = Range("B" & cRow).End(xlDown).Row
    End If
    
    
    '--- 削除処理を開始
    '--- 表示の更新を停止
    Application.ScreenUpdating = False
    Dim lineNum As Long
    For lineNum = eRow To cRow Step -1
        If Cells(lineNum, "B").Value <> "○" Then
            Rows(lineNum).Delete Shift:=xlUp
        End If
    Next
    '--- 表示の更新を有効
    Application.ScreenUpdating = True
End Sub
id:ReoReo7

いつもありがとうございます。

2007/05/30 04:06:02
id:kodomono-omocha No.5

kodomono-omocha回答回数406ベストアンサー獲得回数62007/05/29 20:55:29

ポイント10pt

B列選択

オートフィルタ

ソート(○を含まない)

全選択

行を削除

を記録すればよいのではないでしょうか?

id:ReoReo7

ありがとうございます。言われてみればそういう方法もありますね。

2007/05/30 04:05:41
id:ardarim No.6

ardarim回答回数892ベストアンサー獲得回数1422007/05/30 03:53:17

ポイント40pt

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

Sub ExtractRows()

    Dim r As Long
    
    ' 画面更新禁止
    Application.ScreenUpdating = False
    
    r = ActiveCell.Row
    Do While Cells(r, 2).Value <> ""
        If Cells(r, 2).Value <> "○" Then
            Rows(r).Delete xlShiftUp
        Else
            r = r + 1
        End If
    Loop

    ' 画面更新許可
    Application.ScreenUpdating = True
    
End Sub
id:ReoReo7

いつもありがとうございます。

2007/05/30 04:05:51
  • id:ReoReo7
    列を削除ではなく、行を削除でした。失礼しました。
  • id:taknt
    あ、なんか 文面を おもいきっり勘違いしちゃったみたいですね。

    あと 高速化のため 描画を止めるですが、これは できたかな?

    ちょこっと 修正

    Sub Macro3()

    '

    ' Macro3 Macro

    '

    Dim a As Long
    Dim b As Long
    Dim c As Long

    c = ActiveCell.Row

    For a = c To 65536

    If Range("B" & a) = "" Then Exit For

    Next a


    For b = a To c Step -1

    If Range("B" & b) <> "○" Then Rows(b & ":" & b).Delete Shift:=xlUp

    Next b
    End Sub


    >アクティブセルの行から上から順番に参照していって

    ここが ちょっと わかりにくいところです。

    アクティブセルの行から下に参照していく
    という意味ですよね?

    プログラムの都合上、削除するには 下のほうからしないと
    うまくいきません。
  • id:ReoReo7
    ありがとうございます。

    解釈はそのとおりです。

    了解です。下から削除でも、大丈夫です。

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

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

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

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