質問編集履歴
2
2021/03/07:不要ｺｰﾄﾞを削除しました。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -32,7 +32,6 @@
|
|
|
32
32
|
Dim numberM As Variant '転記元検索値
|
|
33
33
|
Dim resultS As Variant '転記先検索結果
|
|
34
34
|
|
|
35
|
-
'Set TM = Workbooks.5Open(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
36
35
|
Set TM = ThisWorkbook 'このマクロがあるﾌｧｲﾙが転記元
|
|
37
36
|
Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx") '転記先ﾌｧｲﾙ名を変数格納
|
|
38
37
|
|
1
2021/3/7:回答内容を元に編集しました。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -18,7 +18,7 @@
|
|
|
18
18
|
### 該当のソースコード
|
|
19
19
|
|
|
20
20
|
```VBA
|
|
21
|
-
Sub 別ブックへの転記()
|
|
21
|
+
Sub 別ブックへの転記△2()
|
|
22
22
|
Const TenkiMoto As String = "C:\テスト" '転記元ﾌｧｲﾙﾊﾟｽ
|
|
23
23
|
Const TenkiSaki As String = "C:\Users\nakagami\Desktop\サンプル" '転記先ﾌｧｲﾙﾊﾟｽ
|
|
24
24
|
Dim TM As Workbook '転記元ﾌｧｲﾙ名変数
|
|
@@ -32,30 +32,29 @@
|
|
|
32
32
|
Dim numberM As Variant '転記元検索値
|
|
33
33
|
Dim resultS As Variant '転記先検索結果
|
|
34
34
|
|
|
35
|
-
Set TM = Workbooks(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
35
|
+
'Set TM = Workbooks.5Open(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
36
|
+
Set TM = ThisWorkbook 'このマクロがあるﾌｧｲﾙが転記元
|
|
36
|
-
Set TS = Workbooks(TenkiSaki & "\転記先.xlsx") '転記先ﾌｧｲﾙ名を変数格納
|
|
37
|
+
Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx") '転記先ﾌｧｲﾙ名を変数格納
|
|
37
|
-
Set wsM = Workbooks(TM).Worksheets("sheet1") '転記元ｼｰﾄを変数格納
|
|
38
|
-
Set wsS = Workbooks(TS).Worksheets("sheet1") '転記先ｼｰﾄを変数格納
|
|
39
|
-
lastrowM = wsM.Cells(Rows.Count, 1).End(xlUp).Row '転記元ｼｰﾄ最終行数抽出
|
|
40
38
|
|
|
41
|
-
|
|
39
|
+
Set wsM = TM.Worksheets(1) '転記元ｼｰﾄを変数格納
|
|
42
|
-
|
|
40
|
+
Set wsS = TS.Worksheets(1) '転記先ｼｰﾄを変数格納
|
|
43
41
|
|
|
44
|
-
For i = 2 To lastrowM '転記元検索値が存在するまで繰り返す
|
|
45
|
-
numberM = wsM.Cells(i, 2) '転記元検索値を変数格納
|
|
46
|
-
resultS = wsS.Range(wsS.Cells(2, 1), wsS.Cells(lastrowM, 2)).Find(numberM, lookat:=xlWhole) '転記先へ検索
|
|
47
|
-
|
|
48
|
-
If resultS Is Nothing Then '検索値と合致しない場合以下処理実行
|
|
49
|
-
|
|
42
|
+
lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row '転記元ｼｰﾄ最終行数抽出
|
|
50
|
-
|
|
43
|
+
lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先ｼｰﾄ最終行数抽出
|
|
51
44
|
|
|
45
|
+
For i = 2 To lastrowM '転記元検索値が存在するまで繰り返す
|
|
52
|
-
|
|
46
|
+
numberM = wsM.Cells(i, 1).Value '転記元検索値を変数格納
|
|
47
|
+
If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
|
|
48
|
+
lastrowS = lastrowS + 1
|
|
49
|
+
wsS.Cells(lastrowS, 1) = numberM
|
|
53
|
-
|
|
50
|
+
wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value
|
|
54
|
-
|
|
51
|
+
wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value
|
|
52
|
+
Else 'こちらから合致した場合の上書き処理をしたいと考えております。
|
|
53
|
+
|
|
55
|
-
|
|
54
|
+
End If
|
|
55
|
+
Next i
|
|
56
|
+
TS.Close SaveChanges:=True
|
|
56
57
|
|
|
57
|
-
Next i
|
|
58
|
-
Workbooks(TenkiSaki & "\転記先.xlsx").Close
|
|
59
58
|
End Sub
|
|
60
59
|
|
|
61
60
|
```
|