| |
▼だいすけ さん：
>▼ハチ さん：
>IVセルにはちゃんと値が入っております！
>おそらく完全一致ではないからかもしれません。
>
>例えば空白の位置の違いであったり、大文字小文字の違いも
>ありそうです…
>
>何文字以上一致とかで、出来ないでしょうか？
んーー それは比較して一致しているとは言わないと思いますが・・・
何文字以上とかなら検索する仕様を変更して一から作り直しですね。
とりあえず、
「半角全角」「大文字小文字」「前後と間の空白の数」
「A列B列の値を含む（ちょっと微妙）」まで対応しました。
Sub test2()
Dim ws As Worksheet
Dim CV_r As Long 'CVPARTSのRow
Dim R As Range '集めた目録のRange
Dim F As Variant '検索用
'IV列に検索文字列作成
With Worksheets("集めた目録").Range(Worksheets("集めた目録").Range("A1"), _
Worksheets("集めた目録").Range("A65536").End(xlUp)).Offset(, 255)
.Formula = "=TRIM(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 = "=TRIM(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, , , xlPart, , , False, False)
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
