Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

51568 / 76732

←次へ　｜　前へ→


	【30027】Re:AdvancedFilter の使い方

Kein - 05/10/18(火) 16:06 -


	引用なし

	パスワード

Findメソッドで一つずつ拾っていったら、どうでしょーか ?
フィルターを使うコードよりちょっと複雑になりますが、こんな感じです。

Private Sub CommandButton1_Click()
　 Dim txt As String, Ad As String
　 Dim FR As Range
　 Dim RAry() As Long, i As Long

　 txt = Combo科目.Text
　 If txt = "" Then Exit Sub
　 Application.ScreenUpdating = False
　 Set FR = Sheets("【仕訳帳】").Range("A:I") _
　 .Find(txt, , xlValues, xlWhole, , xlPrevious)
　 If FR Is Nothing Then
　　　MsgBox "検索値が見つかりません", 48
　　　GoTo ELine
　 Else
　　　Ad = FR.Address: i = 1
　　　ReDim RAry(i): RAry(i) = 0
　　　Sheets("Sheet2").Rows("2:65536").ClearContents
　 End If
　 Do
　　　Set FR = Sheets("【仕訳帳】").Range("A:I").FindNext(FR)
　　　If IsError(Application.Match(FR.Row, RAry, 0)) Then
　　　　 FR.EntireRow.Copy Sheets("Sheet2").Range("A65536") _
　　　　 .End(xlUp).Offset(1)
　　　　 i = i + 1: ReDim Preserve RAry(i): RAry(i) = FR.Row
　　　End If
　 Loop Until FR.Address = Ad
　 Sheets("Sheet2").Activate
　 Set FR = Nothing: Erase RAry
ELine:
　 Application.ScreenUpdating = True
　 MsgBox "処理を終了します", 64
End Sub　

2 hits

▼

【30024】AdvancedFilter の使い方 琴葉 05/10/18(火) 15:06