VBA 2条件の検索について

質問

VBA初心者です。よろしくお願いします。

下記のような、シートがあります。
　 A B C D E E ・・・・・
1 生産番号 型番 ライン 1/18 1/19 1/20・・・・・・
2 　111 XXX 1
3 222 YYY 2
4 333 ZZZ 3
5 444 AAA 5

ユーザーフォームに生産番号と生産数と日付を入力する
コンボボックスを作成し、生産番号(列)と日付(行)が一致する
セルに生産数を入力するようなVBを作成しています。
（例）生産番号222、生産数200、日付1/20　であれば、
　　　E3のセルに200入力する
Findメソッドでは、2条件の検索が当方実力ではできず、
質問させていただく事となりました。
ちなみにシートも複数有り、全てを検索できるようなVBを考えてます。
検索対象の生産番号・日付は1bookで1つしかありませんので、
検索結果が複数はありません。
よろしくご教示お願いいたします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.4

avanzato · ベストアンサー

#1です。
(2)のコード内で「b」をVariantで宣言していますがDateで宣言してください。
また、最初のErr=91のメッセージボックスの次の行にErr.Clearを追記してください。
あとは
Range("X,Y") = 生産数量BOX.Valueではなく
Cells(X, Y) = 生産数量BOX.Valueとしてください。
Range("X,Y")ですと「X,Y」という名前の付いたエリアに、となります。
また、仮にRange(X,Y)だったとしても列の指定がアルファベットで無い為動作しません。
On Error Resume Nextを実行している為実際はエラーが起きていますが処理が実行されます。

お礼

ずばりです。
自分が思い描いていた様に動作できました。
ありがとうございました。

あともう1点教えて頂きたいのですが、
現在、生産番号をテキストボックスに直接入力していますが、
Columns("A:A")のセルを選択すると、
自動的にボックスに入るようにできないでしょうか？
Private Sub Worksheet_SelectionChange(ByVal Target As Range)にて、
コードを組んでもうまく作動してくれません。
何度もすみませんが、ご教示お願いいたします。

回答No.6

avanzato

#1です。
#5の具体的なコードです。
Private Sub UserForm_Initialize()
　　Dim I As Integer
　　Dim X As Integer
　　Dim Y As Integer
　　X = 1
　　Sheets.Add
　　ActiveSheet.Name = "Temp"
　　For I = 1 To Worksheets.Count
　　　　If Worksheets(I).Name <> "Temp" Then
　　　　　　Y = 2
　　　　　　Do While Worksheets(I).Range("A" & Y).Value <> ""
　　　　　　　　Range("Temp!A" & X).Value = Worksheets(I).Range("A" & Y).Value
　　　　　　　　Range("Temp!B" & X).Formula = "=COUNTIF(A1:A" & X & ",A" & X & ")"
　　　　　　　　X = X + 1
　　　　　　　　Y = Y + 1
　　　　　　Loop
　　　　End If
　　Next I
　　Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
　　I = 1
　　Do While Range("A" & I).Value <> ""
　　　　If Range("B" & I).Value = 1 Then
　　　　　　ComboBox1.AddItem Range("A" & I).Value
　　　　End If
　　　　I = I + 1
　　Loop
　　Application.DisplayAlerts = False
　　Sheets("Temp").Delete
　　Application.DisplayAlerts = True
End Sub

お礼

遅くなりました。
一度トライしてみます。
色々勉強させて頂きありがとうございました。

回答No.5

avanzato

#1です。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
にどのようなコードを組まれたのかわかりませんがWorksheet_SelectionChangeを使用すると全体的なレスポンスが低下します。
一例ですがフォームを起動したタイミングで全シートの製造番号一覧を生成しコンボボックスに流し込む。
またはテキストボックスの脇に製造番号一覧のリストボックスを置き、リストボックス内製造番号をWクリックすることでテキストボックスに製造番号を流す。

VBAには配列のソートが無い為仮のシートＡを挿入し全シートの製造番号をＡ列に入れて行き、全シートの読み込みが完了したらＡ列をソートしてＢ列に重複チェックの数式を入れる。
重複がなく並んだデータをコンボボックスないしリストボックスに入れ、シートＡを削除

大まかにはこのような流れになるかと思います。

回答No.3

avanzato

#1です。
返信が遅れましてすみません。
少しコーディングしてみますが再度内容の確認をお願いします。

フォーム
・・・生産番号（コンボボックス）
・・・日付（コンボボックス）
・・・生産数（コンボボックス）
・・・入力ボタン（コマンドボタン）

条件
・生産番号は同じシート内に複数存在するが他シートには存在しない。
この場合、型番が異なる。
・日付はブックに対し1つしか存在しない。
・同じ日付は複数存在しない。

★ここで疑問になってくることがあります。
条件に従い同シート内に次のようなデータがある場合
-----------------------------
生産番号　型番　2/1　2/2　2/3
11111111　AAAA
22222222　BBBB
11111111　CCCC
-----------------------------
フォームの情報として生産番号・日付・生産数があります。
生産番号が「11111111」の時、生産数を入れる箇所は1行目か3行目か判断する条件はありますか？

補足

ありがとうございます。
貴殿のご質問通り、当方もネックとなり、
下記のように変更して現在作成しているところです。
(1)生産番号のみ入力するユーザーフォーム（生産番号の絞込み）を作成。
　生産番号（テキストボックス）
　絞込み（コマンドボタン）
　　・生産番号入力後、絞込みボタンにて　
　　　対象番号をオートフィルターにて絞り込む。
(2)(1)終了後、新しいユーザーフォーム（生産数量の入力）を作成
　型番（コンボボックス）
　生産数（テキストボックス）
　日付（テキストボックス）
　入力（コマンドボックス）
　　・絞込んだ生産番号に対する型番を選択し、
　　　生産数、日付を入力後、入力ボタンにて、
　　　対象型番の行番号、日付の列番号を取得後、
　　　対象セルに生産数を入れる。

下記にて自分なりにコードを作成しましたが、(1)まではスムーズに動きましたが、(2)でエラーになってしまいます。
(1)
省略します。
(2)
Private Sub UserForm_Initialize()

'フォームが最初に表示された時の初期設定の状態を表します。
型番BOX = ""
生産数量BOX = ""
生産日BOX = Date
型番BOX.SetFocus

Dim buf As String
If Not ActiveSheet.AutoFilterMode Then Exit Sub
With ActiveSheet.AutoFilter.Range
If .Columns.Item(1).SpecialCells(xlCellTypeVisible) _
.Count = 1 Then '抽出データがない場合
Me.型番BOX.Clear
Else
.Resize(.Rows.Count - 1, 1).Offset(1, 1).Copy
With New MSForms.DataObject
.GetFromClipboard
buf = .GetText
End With
.Application.CutCopyMode = True
Me.型番BOX.List = Split(buf, vbCrLf)
End If
End With
End Sub
Private Sub 入力_Click()

If Len(型番BOX.Value) = 0 Then
MsgBox "型番が未選定です"
Cancel = True

ElseIf Len(生産数量BOX.Value) = 0 Then
MsgBox "生産数量が未入力です"
Cancel = True

ElseIf Len(生産日BOX.Value) = 0 Then
MsgBox "生産日が未入力です"
Cancel = True

Else

Dim a As Variant
a = 型番BOX.Value
Dim b As Variant
b = 生産日BOX.Value

On Error Resume Next
Columns("B:B").Select
ActiveSheet.Cells.Find(a, , , xlWhole, xlByRows, xlNext, False).Select
X = ActiveCell.Row

If Err = 91 Then
MsgBox (prompt) & a & "の型番はありません", _
(vbOKOnly + vbExclamation), ("型番検索結果")

End If

On Error Resume Next
Rows("1:1").Select
ActiveSheet.Cells.Find(b, , , xlWhole, xlByColumns, xlNext, False).Select

Y = ActiveCell.Column

If Err = 91 Then
MsgBox (prompt) & b & "の日付はありません", _
(vbOKOnly + vbExclamation), ("日付検索結果")

End If

Range("X,Y") = 生産数量BOX.Value

生産番号の絞込み.Show

Unload 生産数量の入力

End If

Range("A1").Select
End Sub

Private Sub 戻る_Click()

生産番号の絞込み.Show

Unload 生産数量の入力

Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter

End Sub

長々とごめんなさい。どうも行番号と列番号をうまく取得できません。
ご教示ください。

回答No.2

avanzato

#1ですが確認をしたい点があります。
複数シートとの事ですが生産番号は例えばSheet1に111があるとした時Sheet2に同じく111が存在することはありますか？
フォームの生産数はコンボボックスですか？テキストボックスですか？

補足

早速ありがとうございます。
検索対象の生産番号・日付は1bookで1つしかありませんと書きましたが、生産番号はsheet1内に複数ある場合があります。しかし他sheet2,3とかには存在しません。日付はsheet1に存在すると、他シートには存在しません。
生産番号が1sheetに複数存在する場合は、同じ生産番号でも型番が異なります。
フォームは、コンボボックスです。
よろしくお願いします。

回答No.1

avanzato

こんにちは。
Cells.Findで検索をしているのならば全シートをループでCells.Findすます。
この時シート内に対象が無い場合は「ERR」に91が入ります。
この事から先ず生産番号を検索し「ERR」が91でなければそのシートに生産番号が存在することになります。
この時Cells.Find～Activeで生産番号を選択し選択中のセルの行番号を取得します。
次に日付をCells.Find～Activeで列番号を取得。
あとは取得している行番号・列番号に生産数をセットすれば処理が可能です。

補足

早速のご教示ありがとうございます。
もう少し詳細に教えていただけないでしょうか？
当方では、文章だけでは、理解できないレベルですので。。
すいませんがお願いします。