2003でオートフィルタ（3条件以上）マクロ

質問

EXCEL2007で組んでいて、困っています！
2003では、オートフィルタ、3条件までなので、
下記の場合どうすればよいでしょうか・・・
（IF文内、カ行までしかいれてません。
しかも、2007これだと止まってしまうのですが・・・）

Private Sub 検索_Click()
Dim S_Name As String
a_arr = Array("ア", "イ", "ウ", "エ", "オ")
k_arr = Array("カ", "キ", "ク", "ケ", "コ")
s_arr = Array("サ", "シ", "ス", "セ", "ソ")
t_arr = Array("タ", "チ", "ツ", "テ", "ト")
n_arr = Array("ナ", "ニ", "ヌ", "ネ", "ノ")
h_arr = Array("ハ", "ヒ", "フ", "ヘ", "ホ")
m_arr = Array("マ", "ミ", "ム", "メ", "モ")
y_arr = Array("ヤ", "ユ", "ヨ")
r_arr = Array("ラ", "リ", "ル", "レ", "ロ")
w_arr = Array("ワ", "ヲ", "ン")

'シートCOPYのデータを消去
ThisWorkbook.Sheets("copy").Visible = True
Sheets("copy").Cells.Clear
'仕入先名検索の値をコピー
Worksheets("仕入先マスタ").Activate
If 仕入先名検索.Value = "ア" Then
Worksheets("仕入先マスタ").Range("$A$1:$I$65536").AutoFilter Field:=9, Criteria1:=a_arr, Operator:=xlFilterValues
With Worksheets("仕入先マスタ").Range("B1").CurrentRegion
Set r = Cells(65536, .Cells(.Cells.Count).Column).End(xlUp)
Range("A1", r).Select
ElseIf 仕入先名検索.Value = "カ" Then
Worksheets("仕入先マスタ").Range("$A$1:$I$65536").AutoFilter Field:=9, Criteria1:=k_arr, Operator:=xlFilterValues
With Worksheets("仕入先マスタ").Range("A1").CurrentRegion
Set r = Cells(65536, Cells(.Cells.Count).Column).End(xlUp)
Range("A1", r).Select

End With
End If
Selection.Copy
Worksheets("copy").Select
Range("A1").Select
Worksheets("copy").Paste
Application.CutCopyMode = False

Dim myDCount As Long, myDRange As String
myDCount = Worksheets("copy").Range("B1").CurrentRegion.Rows.Count 'データの最終行を取得
myDRange = "copy!B2:C" & myDCount
With 仕入先名
.ColumnCount = 2
.ColumnWidths = "100;20"
.RowSource = myDRange
End With
ThisWorkbook.Sheets("copy").Visible = False
Worksheets("商品マスタ").Activate
End Sub

回答No.1

Wendy02 · ベストアンサー

こんばんは。

コードの間違いがあるようですね。2007でも、2003でも、そのコードは通りません。説明なしでは意味が不明な部分が何点もあります。

こういう場合、だいたい、逆に質問して教えてもらっても、余計に分からなくなるので、こちらの想像で詰めるしかないようです。

たぶん、UserForm から行うように思えるのです。そうしないと、親オブジェクトのない部分で不整合があるから、UserForm が立ち上がっていないと無理があります。ただ、それぐらいは説明していただかないと、突然出てきたオブジェクトで混乱してしまいます。

それと、仕入先名はUserFormのListBox かComboBox 辺りでしょうか？　説明がないと分かりにくいです。

With 仕入先名
　　　　.ColumnCount = 2
　　　　.ColumnWidths = "100;20"
　　　　.RowSource = myDRange
End With

一度、こちらの書いたコードを見てみてください。参考になるべき部分があれば、写してください。ご質問者さんの意図するものと同じかは分かりませんが、読み取れるコードから直してみました。

'-------------------------------------------

Sub Kensaku_Click()
　　Dim S_Name As String
　　Dim a_arr As Variant, k_arr As Variant, s_arr As Variant, t_arr As Variant
　　Dim n_arr As Variant, h_arr As Variant, m_arr As Variant, y_arr As Variant
　　Dim r_arr As Variant, w_arr As Variant
　　Dim 仕入先名検索　As Variant
　　a_arr = Array("ア", "イ", "ウ", "エ", "オ")
　　k_arr = Array("カ", "キ", "ク", "ケ", "コ")
　　s_arr = Array("サ", "シ", "ス", "セ", "ソ")
　　t_arr = Array("タ", "チ", "ツ", "テ", "ト")
　　n_arr = Array("ナ", "ニ", "ヌ", "ネ", "ノ")
　　h_arr = Array("ハ", "ヒ", "フ", "ヘ", "ホ")
　　m_arr = Array("マ", "ミ", "ム", "メ", "モ")
　　y_arr = Array("ヤ", "ユ", "ヨ")
　　r_arr = Array("ラ", "リ", "ル", "レ", "ロ")
　　w_arr = Array("ワ", "ヲ", "ン")
　　 '仕入先名検索 ''TextBox か？
　　'シートCOPYのデータを消去
　　ThisWorkbook.Worksheets("Copy").Visible = True
　　Worksheets("copy").Cells.Clear
　　'仕入先名検索の値をコピー
　　With Worksheets("仕入先マスタ")
　　　　.Activate
　　　　.AutoFilterMode = False
　　End With
　　Select Case 仕入先名検索.Value
　　　　Case "ア": AutoFilterPro (a_arr)
　　　　Case "カ": AutoFilterPro (k_arr)
　　　　Case "サ": AutoFilterPro (s_arr)
　　　　Case "タ": AutoFilterPro (t_arr)
　　　　Case "ナ": AutoFilterPro (n_arr)
　　　　Case "ハ": AutoFilterPro (h_arr)
　　　　Case "マ": AutoFilterPro (m_arr)
　　　　Case "ヤ": AutoFilterPro (y_arr)
　　　　Case "ラ": AutoFilterPro (r_arr)
　　　　Case "ワ": AutoFilterPro (w_arr)
　　　　Case Else : Exit Sub
　　End Select
　　Call ArrangeListBox
End Sub

Sub AutoFilterPro(arg As Variant)
　　Dim c As Variant
　　Dim k As Variant
　　Dim v As Long
　　Application.ScreenUpdating = False
　　With Worksheets("仕入先マスタ")
　　　　v = Val(Application.Version)
　　　　'バージョンの違いは、ディレクティブ分岐にする
　　　　#If v <= 11 Then
　　　　For Each c In .Range("I1", .Range("I65536").End(xlUp))
　　　　　　k = Application.Match(c.Value, arg, 0)
　　　　　　c.Offset(, 1).Value = IsNumeric(k) * -1
　　　　Next
　　　　.Range("A1", .Range("J65536").End(xlUp)).AutoFilter _
　　　　Field:=10, Criteria1:=1
　　　　#Else
　　　　.Range(.Cells(1, 1), Cells(Rows.Count, 9).End(xlUp)).AutoFilter _
　　　　Field:=9, Criteria1:=arg, Operator:=xlFilterValues
　　　　#End If
　　　　With .AutoFilter.Range
　　　　　　.Resize(, .Columns.Count - 1).Copy Worksheets("Copy").Range("A1")
　　　　End With
　　　　.AutoFilterMode = False
　　　　#If v <= 11 Then
　　　　.Range("J1", Range("J65536").End(xlUp)).ClearContents
　　　　#End If
　　End With
　　Application.ScreenUpdating = True
End Sub

Sub ArrangeListBox()
Dim myDCount As Long
Dim sRange As String　'変数名を変えた

　　myDCount = Worksheets("copy").Range("B1").CurrentRegion.Rows.Count 'データの最終行を取得
　　sRange = "copy!B2:C" & myDCount

　　With 仕入先名　'UserForm のListBox ?
　　　　.ColumnCount = 2
　　　　.ColumnWidths = "100;20"
　　　　.RowSource = sRange
　　End With　
　　ThisWorkbook.Sheets("copy").Visible = False
　　Worksheets("商品マスタ").Activate
End Sub

補足

すみません!!
まったく、おっしゃるとおりです。
せっかく組んだコードが2003で動かない！とパニックでした（汗）
ユーザーフォームからcomboboxで選び検索をかけ
comboboxに吐き出すといった具合です。
教えて頂いたコード、参考にがんばってみます。
なるほどなるほど。わかり易く書いていただいて有難うございます。
（質問はわかりづらいのに・・・）