質問編集履歴
2
コードをマークダウンしました。
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -19,7 +19,7 @@
|
|
|
19
19
|
|
|
20
20
|
|
|
21
21
|
### 該当のソースコード
|
|
22
|
-
|
|
22
|
+
```
|
|
23
23
|
Sub 照合転記()
|
|
24
24
|
Const source As String = "C:\Users\xxx\Desktop\yyy\00_VBA\照合転記" '転記元パス
|
|
25
25
|
Const copy As String = "C:\Users\xxx\Desktop\yyy\00_VBA\照合転記"
|
|
@@ -69,7 +69,7 @@
|
|
|
69
69
|
Application.DisplayAlerts = True 'メッセージ表示※上書き保存
|
|
70
70
|
Application.ScreenUpdating = True '画面チラツキ防止
|
|
71
71
|
End sub
|
|
72
|
-
|
|
72
|
+
```
|
|
73
73
|
### 補足
|
|
74
74
|
転記元：年月セルは日付型
|
|
75
75
|
転記先：Ｆ工程セルは日付型
|
1
完成状態とコード再表示しました。
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -3,6 +3,8 @@
|
|
|
3
3
|
●転記先excel
|
|
4
4
|
|
|
5
5
|
### 実現したいこと
|
|
6
|
+
●完成状態
|
|
7
|
+
|
|
6
8
|
テーマ：転記元excelの共通ｷｰと転記先excelを部分照合し、数値をｶｳﾝﾄ計算
|
|
7
9
|
部分照合ｷｰ:yyyy/mm
|
|
8
10
|
①転記元excelのｾﾙA3から最終行までの値に対して、
|
|
@@ -41,24 +43,24 @@
|
|
|
41
43
|
For i = 3 To slastline '転記元データ分繰り返す
|
|
42
44
|
Set sfresult = sWs.Cells(i, 1)
|
|
43
45
|
sfresult = Left(sfresult, 7) 'yyyy/mm取出し
|
|
44
|
-
If sfresult = "" Then '空白飛ばし
|
|
46
|
+
If sfresult = "" Then '空白飛ばし
|
|
45
47
|
GoTo next1:
|
|
46
48
|
End If
|
|
47
49
|
|
|
48
|
-
|
|
50
|
+
Set cfresult = cWb.Worksheets("転記先").Range(Cells(2, 1), Cells(clastline, 1)).Find(sfresult, lookat:=xlPart) 'yyyy/mmで部分検索
|
|
49
51
|
If cfresult Is Nothing Then '不一致は、何も処理を行わない
|
|
50
52
|
|
|
51
|
-
|
|
53
|
+
ElseIf Not cfresult Is Nothing Then '合致は、以下条件式へ進む
|
|
52
54
|
If cWs.Cells(cfresult.Row, 3).Value <> "" Then 'F工程欄に値が入っている場合は以下処理
|
|
53
55
|
Cells(cfresult.Row, 3).Value = Cells(cfresult.Row, 3).Value + 1
|
|
54
56
|
|
|
55
|
-
|
|
57
|
+
ElseIf Not cfresult Is Nothing Then 'F工程乱に値が入っていない場合は以下処理
|
|
56
58
|
Cells(cfresult.Row, 3).Value = 1
|
|
57
59
|
|
|
58
|
-
|
|
60
|
+
End If
|
|
59
61
|
next1:
|
|
60
62
|
|
|
61
|
-
|
|
63
|
+
End If
|
|
62
64
|
Next i
|
|
63
65
|
|
|
64
66
|
Application.DisplayAlerts = False
|