Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

43733 / 76732

←次へ　｜　前へ→


	【38027】Re:複数条件の一致について

ハチ - 06/5/25(木) 11:43 -


	引用なし

	パスワード

こんな感じでどうでしょ。
文字列をくっつけて検索にしてみました。
ちょっとですが注釈も入れたので解析してみてください。

Sub test()

Dim ws As Worksheet
Dim CV_r As Long 'CVPARTSのRow
Dim Mas_r As Long 'マスターのRow
Dim R As Range　'集めた目録のRange
Dim F As Variant '検索用

'IV列に検索文字列作成
With Worksheets("集めた目録").Range(Range("A1"), Range("A65536").End(xlUp)).Offset(, 255)
　　.Formula = "=CONCATENATE(A1,B1)"
　　.Value = .Value
End With
For Each ws In ThisWorkbook.Worksheets
　　If InStr(1, ws.Name, "マスター") <> 0 Then
　　　　With ws.Range(ws.Range("A1"), ws.Range("A65536").End(xlUp)).Offset(, 255)
　　　　　　.Formula = "=CONCATENATE(D1,G1)"
　　　　　　.Value = .Value
　　　　End With
　　End If
Next ws

CV_r = 10 'CV_rは10行目から
'集めた目録のIV列をループ
For Each R In Range(Worksheets("集めた目録").Range("IV1"), Worksheets("集めた目録").Range("IV65536").End(xlUp))
　　'マスターを含むWorkSheetsをループ
　　For Each ws In ThisWorkbook.Worksheets
　　　　If InStr(1, ws.Name, "マスター") <> 0 Then
　　　　　　'マスターIV列でRを検索してあったら、CVRARTSに書き込み
　　　　　　Set F = ws.Range("IV:IV").Find(R.Value, , xlValues, xlWhole)
　　　　　　If Not F Is Nothing Then
　　　　　　　　With Worksheets("CVPARTS")
　　　　　　　　　　.Range(.Cells(CV_r, 5), .Cells(CV_r, 19)).Value = _
　　　　　　　　　　ws.Range(ws.Cells(F.Row, 4), ws.Cells(F.Row, 18)).Value
　　　　　　　　End With
　　　　　　　　'CV_r を1行移動
　　　　　　　　CV_r = CV_r + 1
　　　　　　　　Exit For
　　　　　　End If
　　　　End If
　　Next ws
Next R
'IV列を削除
Worksheets("集めた目録").Range("IV:IV").Clear
For Each ws In ThisWorkbook.Worksheets
　　If InStr(1, ws.Name, "マスター") <> 0 Then
　　　　ws.Range("IV:IV").Clear
　　End If
Next ws

End Sub

3 hits

▼

【37997】複数条件の一致について だいすけ 06/5/24(水) 22:09