質問編集履歴
2
コードをマークダウンしました。
    
        title	
    CHANGED
    
    | 
         
            File without changes
         
     | 
    
        body	
    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 
     | 
    
         
             
            転記先:F工程セルは日付型
         
     | 
1
完成状態とコード再表示しました。
    
        title	
    CHANGED
    
    | 
         
            File without changes
         
     | 
    
        body	
    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 
     | 
    
         
            -
             
     | 
| 
      
 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
         
     |