|
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
|
|