VBAのオートフィルター実行時エラーで「’rangeクラスのAutoFilterメッソドが失敗しました’」
が表示されるのですが、エラーの内容がわかりません。教えて下さい。
Sub 複数条件でのデータ抽出()
Const OrigSheetName = "データベース"
Const PasteSheetName = "検索＆抽出"
Const ItemRow = 2
Const FirstColumn = "A"
Const LastColumn = "CH"
Const UnnecessaryColumns = "W:CD"
Const SearchColumn1 = "CF"
Const SearchColumn2 = "I"
Const PasteCell = "A2"
Dim OrigSheet As Worksheet, PasteSheet As Worksheet, _
LastRow As Long, Region As Variant, Period(1, 1) As Variant, _
temp As Variant, i As Long, c As Range
Period(0, 0) = "1905/1/1"
Period(1, 0) = "9999/12/31"
Period(0, 1) = "以降"
Period(1, 1) = "以前"
If IsError(Evaluate("ROW('" & OrigSheetName & "'!A1)")) Then
MsgBox "元データが入力されているシートとして設定されている" _
& vbCrLf & vbCrLf & OrigSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set OrigSheet = Sheets(OrigSheetName)
If IsError(Evaluate("ROW('" & PasteSheetName & "'!A1)")) Then
MsgBox "データの転記先のシートとして設定されている" _
& vbCrLf & vbCrLf & PasteSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set PasteSheet = Sheets(PasteSheetName)
With OrigSheet
LastRow = .Range(LastColumn & Rows.Count).End(xlUp).Row
With .Range(LastColumn & Rows.Count).End(xlUp)
If LastRow > .Row Then LastRow = .Row
End With
If LastRow <= ItemRow Then GoTo label9
label1:
Region = Application.InputBox("参加または不参加を入力！", SearchColumn2 & _
"列に入力されている区分（Ａ組またはＢ組）の中で、抽出条件を入力して下さい", _
, Type:=6)
If Region = vbNullString Or Region = False Then
temp = MsgBox("区分が入力されていません。" & vbCrLf _
& "区分の入力をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:区分の入力をやり直します" & vbCrLf _
& "[いいえ]:処理を中止してマクロを終了します", _
vbYesNo + vbExclamation, "区分未入力")
If temp = vbNo Then
Exit Sub
Else
GoTo label1
End If
End If
For i = 0 To 1
label2:
Period(i, 0) = Application.InputBox("期間指定" & i + 1, SearchColumn1 & _
"列に入力されている日付" _
& "で抽出する期間を指定して下さい。", _
Period(i, 0), Type:=2)
If Period(i, 0) = vbNullString Or Period(i, 0) = False Then
temp = MsgBox("日付が入力されていません。" & vbCrLf _
& "日付の入力をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:日付の入力をやり直します" & vbCrLf _
& "[いいえ]:処理を中止してマクロを終了します", _
vbYesNo + vbExclamation, "日付未入力")
If temp = vbNo Then
Exit Sub
Else
GoTo label2
End If
End If
If IsDate(Period(i, 0)) Then
If Format(Period(i, 0), "yyyy/mm/dd") = DateValue(Period(i, 0)) & "" _
Then GoTo label3
End If
temp = MsgBox("入力された値は日付として扱う事が出来ません。" _
& vbCrLf & "日付の入力をやり直して下さい。", _
vbOKOnly + vbExclamation, "入力値不適切")
GoTo label2
label3:
Period(i, 0) = DateValue(Period(i, 0))
Next i
End With
With Application
.ScreenUpdating = False
.Calculation = xlManual
End With
With OrigSheet
.Columns(UnnecessaryColumns).Hidden = True
With .Range(SearchColumn1 & ItemRow & ":" & SearchColumn2 & LastRow)
.AutoFilter Field:=1, Criteria1:=Region
.AutoFilter Field:=Columns(SearchColumn1 & ":" & SearchColumn2).Columns.Count, _
Criteria1:=">=" & Period(0, 0), Operator:=xlAnd, Criteria2:="<=" & Period(1, 0)
End With
Set c = .Range(FirstColumn & ItemRow & ":" & LastColumn & LastRow)
i = c.Resize(, 1).SpecialCells(xlCellTypeVisible).Cells.Count
End With
If i > 1 Then
With PasteSheet
.Range(PasteCell & ":" & .Cells.SpecialCells(xlCellTypeLastCell).Address).Clear
c.SpecialCells(xlCellTypeVisible).Copy
With .Range(PasteCell)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteFormats
End With
End With
End If
With c.EntireColumn
.AutoFilter
.Hidden = False
End With
If i > 1 Then GoTo labelE
label9:
MsgBox DateCell & "該当するデータが見つかりません。" & vbCrLf _
& "マクロの実行を中止します。", vbExclamation, "データ無し" & vbCrLf & i
labelE:
With Application
.CutCopyMode = False
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub
１か月ほど前までは問題なく実行出来ていました。元のデータベースの表を編集（列の追加）しましたが、元となるセルは変更しています。
宜しくお願いします！
エクセル VBAのオートフィルター実行時エラーについて教えて下さい
VBAのオートフィルター実行時エラーで「’rangeクラスのAutoFilterメッソドが失敗しました’」
が表示されるのですが、エラーの内容がわかりません。教えて下さい。
Sub 複数条件でのデータ抽出()
Const OrigSheetName = "データベース"
Const PasteSheetName = "検索＆抽出"
Const ItemRow = 2
Const FirstColumn = "A"
Const LastColumn = "CH"
Const UnnecessaryColumns = "W:CD"
Const SearchColumn1 = "CF"
Const SearchColumn2 = "I"
Const PasteCell = "A2"
Dim OrigSheet As Worksheet, PasteSheet As Worksheet, _
LastRow As Long, Region As Variant, Period(1, 1) As Variant, _
temp As Variant, i As Long, c As Range
Period(0, 0) = "1905/1/1"
Period(1, 0) = "9999/12/31"
Period(0, 1) = "以降"
Period(1, 1) = "以前"
If IsError(Evaluate("ROW('" & OrigSheetName & "'!A1)")) Then
MsgBox "元データが入力されているシートとして設定されている" _
& vbCrLf & vbCrLf & OrigSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set OrigSheet = Sheets(OrigSheetName)
If IsError(Evaluate("ROW('" & PasteSheetName & "'!A1)")) Then
MsgBox "データの転記先のシートとして設定されている" _
& vbCrLf & vbCrLf & PasteSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Set PasteSheet = Sheets(PasteSheetName)
With OrigSheet
LastRow = .Range(LastColumn & Rows.Count).End(xlUp).Row
With .Range(LastColumn & Rows.Count).End(xlUp)
If LastRow > .Row Then LastRow = .Row
End With
If LastRow <= ItemRow Then GoTo label9
label1:
Region = Application.InputBox("参加または不参加を入力！", SearchColumn2 & _
"列に入力されている区分（Ａ組またはＢ組）の中で、抽出条件を入力して下さい", _
, Type:=6)
If Region = vbNullString Or Region = False Then
temp = MsgBox("区分が入力されていません。" & vbCrLf _
& "区分の入力をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:区分の入力をやり直します" & vbCrLf _
& "[いいえ]:処理を中止してマクロを終了します", _
vbYesNo + vbExclamation, "区分未入力")
If temp = vbNo Then
Exit Sub
Else
GoTo label1
End If
End If
For i = 0 To 1
label2:
Period(i, 0) = Application.InputBox("期間指定" & i + 1, SearchColumn1 & _
"列に入力されている日付" _
& "で抽出する期間を指定して下さい。", _
Period(i, 0), Type:=2)
If Period(i, 0) = vbNullString Or Period(i, 0) = False Then
temp = MsgBox("日付が入力されていません。" & vbCrLf _
& "日付の入力をやり直しますか?" & vbCrLf & vbCrLf _
& "[はい]:日付の入力をやり直します" & vbCrLf _
& "[いいえ]:処理を中止してマクロを終了します", _
vbYesNo + vbExclamation, "日付未入力")
If temp = vbNo Then
Exit Sub
Else
GoTo label2
End If
End If
If IsDate(Period(i, 0)) Then
If Format(Period(i, 0), "yyyy/mm/dd") = DateValue(Period(i, 0)) & "" _
Then GoTo label3
End If
temp = MsgBox("入力された値は日付として扱う事が出来ません。" _
& vbCrLf & "日付の入力をやり直して下さい。", _
vbOKOnly + vbExclamation, "入力値不適切")
GoTo label2
label3:
Period(i, 0) = DateValue(Period(i, 0))
Next i
End With
With Application
.ScreenUpdating = False
.Calculation = xlManual
End With
With OrigSheet
.Columns(UnnecessaryColumns).Hidden = True
With .Range(SearchColumn1 & ItemRow & ":" & SearchColumn2 & LastRow)
.AutoFilter Field:=1, Criteria1:=Region
.AutoFilter Field:=Columns(SearchColumn1 & ":" & SearchColumn2).Columns.Count, _
Criteria1:=">=" & Period(0, 0), Operator:=xlAnd, Criteria2:="<=" & Period(1, 0)
End With
Set c = .Range(FirstColumn & ItemRow & ":" & LastColumn & LastRow)
i = c.Resize(, 1).SpecialCells(xlCellTypeVisible).Cells.Count
End With
If i > 1 Then
With PasteSheet
.Range(PasteCell & ":" & .Cells.SpecialCells(xlCellTypeLastCell).Address).Clear
c.SpecialCells(xlCellTypeVisible).Copy
With .Range(PasteCell)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteFormats
End With
End With
End If
With c.EntireColumn
.AutoFilter
.Hidden = False
End With
If i > 1 Then GoTo labelE
label9:
MsgBox DateCell & "該当するデータが見つかりません。" & vbCrLf _
& "マクロの実行を中止します。", vbExclamation, "データ無し" & vbCrLf & i
labelE:
With Application
.CutCopyMode = False
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub
１か月ほど前までは問題なく実行出来ていました。元のデータベースの表を編集（列の追加）しましたが、元となるセルは変更しています。
宜しくお願いします！
【環境】
・Windows7 Pro 32bit
・VS.net2010（VB.NET）
・Excel2013
・.net Framework 4.0
お世話になります。
VB.NETを使用して、あるCSVファイルを読み込み、
その読み込んだ内容を既存Excelファイルに対して書き込みを行うプログラムを書いております。
書き込む際、Excelシート内の特定の１つの列をキー項目としておりまして、
CSVから読み込んだ値とExcel側のキー値を比較して該当した行の特定のセルに
値をセットするような処理を行っています。
１回１回セルを参照して値を取得し、CSVの値と比較するようなことは避けようと思い、
初めはFind関数を使用していました。
しかし、Find関数は処理が遅いという記事をネットで見てから
Match関数を使うと良いという内容でしたので、
早速Match関数を使用しようと思い以下の様なコードを書いてみたのですが
エラーとなってしまいます。
※Lookup系の関数も同じエラーになります。
-エラーメッセージ-
COMExceptionはハンドルされませんでした。
WorksheetFunction クラスの Match メソッドが失敗しました。
エラーコード：-2146827284
Dim ret As Integer = 0
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Sheet
Dim xlFunc As Excel.WorksheetFunction = xlApp.WorksheetFunction
Dim rTemp As Excel.Range
rTemp = xlSheet.Range("A1:A10")
ret = xlFunc.Match("12345", rTemp , 0) '←ここでエラー
※上記コードは一部を抜粋してきたものです。
ただ、Count関数やMax関数、Min関数などは問題なく使用出来ましたので
xlFuncが機能していない訳ではなさそうです。
Matchの書き方に問題があるのでしょうか。
また、そもそも使用出来ないものなのでしょうか。
何かお分かりになる方、もしいらっしゃいましたらご教示の程お願い致します。
【環境】
・Windows7 Pro 32bit
・VS.net2010（VB.NET）
・Excel2013
・.net Framework 4.0
お世話になります。
VB.NETを使用して、あるCSVファイルを読み込み、
その読み込んだ内容を既存Excelファイルに対して書き込みを行うプログラムを書いております。
書き込む際、Excelシート内の特定の１つの列をキー項目としておりまして、
CSVから読み込んだ値とExcel側のキー値を比較して該当した行の特定のセルに
値をセットするような処理を行っています。
１回１回セルを参照して値を取得し、CSVの値と比較するようなことは避けようと思い、
初めはFind関数を使用していました。
しかし、Find関数は処理が遅いという記事をネットで見てから
Match関数を使うと良いという内容でしたので、
早速Match関数を使用しようと思い以下の様なコードを書いてみたのですが
エラーとなってしまいます。
※Lookup系の関数も同じエラーになります。
-エラーメッセージ-
COMExceptionはハンドルされませんでした。
WorksheetFunction クラスの Match メソッドが失敗しました。
エラーコード：-2146827284
Dim ret As Integer = 0
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Sheet
Dim xlFunc As Excel.WorksheetFunction = xlApp.WorksheetFunction
Dim rTemp As Excel.Range
rTemp = xlSheet.Range("A1:A10")
ret = xlFunc.Match("12345", rTemp , 0) '←ここでエラー
※上記コードは一部を抜粋してきたものです。
ただ、Count関数やMax関数、Min関数などは問題なく使用出来ましたので
xlFuncが機能していない訳ではなさそうです。
Matchの書き方に問題があるのでしょうか。
また、そもそも使用出来ないものなのでしょうか。
何かお分かりになる方、もしいらっしゃいましたらご教示の程お願い致します。
