初めての店舗開業を成功させよう>>

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

A 回答 (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に吐き出すといった具合です。
教えて頂いたコード、参考にがんばってみます。
なるほどなるほど。わかり易く書いていただいて有難うございます。
(質問はわかりづらいのに・・・)

補足日時:2009/11/15 09:51
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング