質問編集履歴
2
2021/03/07:不要ｺｰﾄﾞを削除しました。
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -65,8 +65,6 @@
|
|
|
65
65
|
Dim resultS As Variant '転記先検索結果
|
|
66
66
|
|
|
67
67
|
|
|
68
|
-
|
|
69
|
-
'Set TM = Workbooks.5Open(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
70
68
|
|
|
71
69
|
Set TM = ThisWorkbook 'このマクロがあるﾌｧｲﾙが転記元
|
|
72
70
|
|
1
2021/3/7:回答内容を元に編集しました。
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -38,7 +38,7 @@
|
|
|
38
38
|
|
|
39
39
|
```VBA
|
|
40
40
|
|
|
41
|
-
Sub 別ブックへの転記()
|
|
41
|
+
Sub 別ブックへの転記△2()
|
|
42
42
|
|
|
43
43
|
Const TenkiMoto As String = "C:\テスト" '転記元ﾌｧｲﾙﾊﾟｽ
|
|
44
44
|
|
|
@@ -66,53 +66,51 @@
|
|
|
66
66
|
|
|
67
67
|
|
|
68
68
|
|
|
69
|
-
Set TM = Workbooks(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
69
|
+
'Set TM = Workbooks.5Open(TenkiMoto & "\テスト\転記元.xlsm") '転記元ﾌｧｲﾙ名を変数格納
|
|
70
70
|
|
|
71
|
-
Set T
|
|
71
|
+
Set TM = ThisWorkbook 'このマクロがあるﾌｧｲﾙが転記元
|
|
72
72
|
|
|
73
|
-
Set wsM = Workbooks(TM).Worksheets("sheet1") '転記元ｼｰﾄを変数格納
|
|
74
|
-
|
|
75
|
-
Set
|
|
73
|
+
Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx") '転記先ﾌｧｲﾙ名を変数格納
|
|
76
|
-
|
|
77
|
-
lastrowM = wsM.Cells(Rows.Count, 1).End(xlUp).Row '転記元ｼｰﾄ最終行数抽出
|
|
78
74
|
|
|
79
75
|
|
|
80
76
|
|
|
81
|
-
Work
|
|
77
|
+
Set wsM = TM.Worksheets(1) '転記元ｼｰﾄを変数格納
|
|
82
78
|
|
|
83
|
-
|
|
79
|
+
Set wsS = TS.Worksheets(1) '転記先ｼｰﾄを変数格納
|
|
84
80
|
|
|
85
81
|
|
|
86
82
|
|
|
87
|
-
|
|
83
|
+
lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row '転記元ｼｰﾄ最終行数抽出
|
|
88
84
|
|
|
89
|
-
numberM = wsM.Cells(i, 2) '転記元検索値を変数格納
|
|
90
|
-
|
|
91
|
-
resultS = wsS.Range(wsS.Cells(2, 1), wsS.Cells(lastrowM, 2)).Find(numberM, lookat:=xlWhole) '転記先へ検索
|
|
92
|
-
|
|
93
|
-
|
|
94
|
-
|
|
95
|
-
If resultS Is Nothing Then '検索値と合致しない場合以下処理実行
|
|
96
|
-
|
|
97
|
-
|
|
85
|
+
lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先ｼｰﾄ最終行数抽出
|
|
98
|
-
|
|
99
|
-
wsS.Cells(1, j) = numberM.Value '次行へ転記
|
|
100
86
|
|
|
101
87
|
|
|
102
88
|
|
|
103
|
-
|
|
89
|
+
For i = 2 To lastrowM '転記元検索値が存在するまで繰り返す
|
|
104
90
|
|
|
105
|
-
ws
|
|
91
|
+
numberM = wsM.Cells(i, 1).Value '転記元検索値を変数格納
|
|
106
92
|
|
|
107
|
-
|
|
93
|
+
If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
|
|
108
94
|
|
|
95
|
+
lastrowS = lastrowS + 1
|
|
96
|
+
|
|
97
|
+
wsS.Cells(lastrowS, 1) = numberM
|
|
98
|
+
|
|
99
|
+
wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value
|
|
100
|
+
|
|
101
|
+
wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value
|
|
102
|
+
|
|
103
|
+
Else 'こちらから合致した場合の上書き処理をしたいと考えております。
|
|
104
|
+
|
|
105
|
+
|
|
106
|
+
|
|
109
|
-
End If
|
|
107
|
+
End If
|
|
108
|
+
|
|
109
|
+
Next i
|
|
110
|
+
|
|
111
|
+
TS.Close SaveChanges:=True
|
|
110
112
|
|
|
111
113
|
|
|
112
|
-
|
|
113
|
-
Next i
|
|
114
|
-
|
|
115
|
-
Workbooks(TenkiSaki & "\転記先.xlsx").Close
|
|
116
114
|
|
|
117
115
|
End Sub
|
|
118
116
|
|