シリアルを【Alt+Enter】で区切ることはできましたが、
Findしようとすると以下の文で「型が一致していません」と表示されます。
Set c = wb.Sheets("sheet1").Cells.Find(what:=tep, LookAt:=xlWhole)
(その後の処理もかけていません・・)
よろしくお願いします。
該当のソースコード
VBA
1Sub Sample()
23 Dim wb As Workbook
4 Dim i As Integer
5 Dim myselect As Variant
6 Dim tmp As Variant
7 Dim c As Range
89 Application.ScreenUpdating = False
10 Set wb = Workbooks.Open("C:\Users\在庫.xlsx")
1112 For i = Selection(1).Row To Selection(Selection.Count).Row
13 myselect = Cells(i, 3)
14 tmp = Split(myselect, vbLf)
15 Set c = wb.Sheets("sheet1").Cells.Find(what:=tep, LookAt:=xlWhole)
161718 Next i
1920 wb.Close (False)
21 Application.ScreenUpdating = True
2223End Sub
というわけで、 Set c = wb.Sheets("sheet5").Cells.Find(what:=tmp, LookAt:=xlWhole)
の部分も本来は Set c = wb.Sheets("sheet5").Cells.Find(what:=tmp(0), LookAt:=xlWhole)
のように添え字をつけるのが正解なのですが、これもVB特有の冗長解釈で「添え字がなければ先頭の添え字」として処理されるものと思います。
Sub Sample1()
Dim wb As Workbook
Dim i As Integer
Dim myselect As Variant
Dim c As Range
Dim tmp() As String '文字列配列で宣言
Dim t As Variant 'Split結果の要素取出し用。ForEachで取り出す要素はVariantで宣言する必要がある
Application.ScreenUpdating = False
Set wb = Workbooks.Open("C:\Users\在庫.xlsx")
ThisWorkbook.Activate
For i = Selection(1).Row To Selection(Selection.Count).Row
myselect = Cells(i, 3)
tmp = Split(myselect.Value, vbLf)
For Each tmp In Split(myselect.Value, vbLf)
Set c = wb.Sheets("sheet1").Cells.Find(what:=tmp, LookAt:=xlWhole)
'~後続の処理~
Next tmp
Next i
End Sub
Sample2:UBoundの場合
Sub Sample2()
Dim wb1 As Workbook '購入履歴ブック
Dim ws1 As Worksheet '購入履歴シート
Dim wb2 As Workbook '在庫ブック
Dim ws2 As Worksheet '在庫シート
Dim i As Integer
Dim myselect As Variant
Dim c As Range
Dim rngSel As Range '選択されているセル範囲
Dim tmp() As String '文字列配列で宣言
Dim cnt As Integer 'Split結果の要素数カウンタ
Application.ScreenUpdating = False
'購入者履歴ブック
Set wb1 = ThisWorkbook
'Set ws1 = wb1.Worksheets("Sheet1")
Set ws1 = wb1.ActiveSheet
'在庫ブック
Set wb2 = Workbooks.Open("C:\Users\在庫.xlsx")
'Set ws2 = wb2.Worksheets("Sheet1")
Set ws2 = wb2.ActiveSheet
'Selectionはアクティブなシートのみ取得できるため、対象シートをアクティブ化する
ws1.Activate
'選択範囲を変数に格納(※処理中のシート変更や別ブックのオープンによる誤動作を防止するため)
Set rngSel = Selection
'選択範囲をループ処理
For i = rngSel(1).Row To rngSel(rngSel.Count).Row
myselect = ws1.Cells(i, 3)
tmp = Split(myselect, vbLf)
For cnt = 0 To UBound(tmp)
'シリアルの一致するセルを検索
Set c = ws2.Cells.Find(what:=tmp(cnt), LookAt:=xlWhole)
If Not c Is Nothing Then
'一致するセルが見つかったら転記
ws2.Cells(c.Row, "B") = ws1.Cells(i, "B")
End If
Next cnt
Next i
'ブックのクローズ
wb2.Close (False)
'解放
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Application.ScreenUpdating = True
End Sub
1'検索元データ(購入者履歴シリアル)の入ったセル参照
2Set myselect = Cells(i, 3)
3'検索元データを行分割し、要素毎にループ
4For Each tmp In Split(myselect.Value, vbLf)
5 '在庫シートからシリアルを検索
6 Set c = wb.Sheets("sheet1").Cells.Find(what:=tmp, LookAt:=xlWhole)
7 '対象のシリアルが見つかったか
8 If Not c Is Nothing Then
9 '見つかったシリアルセルの左側のセルに、購入者履歴シリアルセルの左側のセルの値をセット
10 c.Offset(0, -1).Value = myselect.Offset(0, -1).Value
11 End If
12Next
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2019/01/23 02:38
2019/01/23 02:47