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ベストアンサー
- 回答日時:
こんばんは。
コードの間違いがあるようですね。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に吐き出すといった具合です。
教えて頂いたコード、参考にがんばってみます。
なるほどなるほど。わかり易く書いていただいて有難うございます。
(質問はわかりづらいのに・・・)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の 4 2023/01/12 23:40
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) 【至急】Excel 同一人物の情報を一行にまとめる(複数行) 6 2022/05/24 17:58
- Visual Basic(VBA) Sheet1をフィルターで「りんご」を抽出し、Sheet2へ地域を貼り付ける下記マクロを変更して S 2 2022/12/11 03:01
- Excel(エクセル) vba 転記するときの最終行について 2 2022/09/03 09:31
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) VBAが止まります。 1 2022/09/02 14:51
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
Excel 日付を比較したら、同じ...
-
英数字のみ全角から半角に変換
-
会社PCのメールが更新されない
-
Outlookを立ち上げたらGoogleロ...
-
outlookのメールが固まってしま...
-
Excelで空白以外の値がある列の...
-
ウィンドウィズ メモ帳で日付だ...
-
Excelに貼ったリンクについて E...
-
Microsoft Formsの「個人情報や...
-
Excelで時間計算(負)
-
microsoft office
-
【Excel VBA】PDFを作成して,...
-
エクセルでXLOOKUP関数...
-
マイクロソフト 一時使用コード...
-
Outlookでの時間指定送信機能に...
-
【スプレドシート】目標達成の...
-
Googleのスプレッドシートでシ...
-
Microsoft Officeを2台目のPCに...
-
MicrosoftOfficeについて質問で...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
【スプレッドシート】指定の日...
-
英数字のみ全角から半角に変換
-
会社PCのメールが更新されない
-
マイクロソフト 一時使用コード...
-
Office 2021 Professional Plus...
-
エクセルで例えば、関数を使っ...
-
Microsoft Formsの「個人情報や...
-
1つのPCに「Excel 2010」「Exc...
-
エクセルで例えば、A1に㈱ベ...
-
理由を教えてください。
-
エクセルでXLOOKUP関数...
-
マイクロソフト オフィスについて
-
VLOOKUP関数について
-
teams設定教えて下さい。 ①ビデ...
-
Googleのスプレッドシートでシ...
-
【Excel VBA】PDFを作成して,...
-
Microsoft365で写真をアルバム...
-
Outlook で宛先が複数の場合の人数
-
Excel テーブル内の空白行の削除
おすすめ情報