VBA マクロでエクセル間の決まった行の転記を実装したいが結果が不正になります。

以下の「現状のソース」を実行すると、[現状の実行結果]のようになり、「月」が正しく転記されません。

どのようにしたら、[実装したい実行結果]のように正しく開発A1の担当者と月数の行を実装できるでしょうか。

教えていただけると幸いです。

[現状のソース]

Macro
1Sub sample1()
2
3    Dim lngRowsNo As Long                        ' 書きこむ位置(行)
4    Dim lngSheetIndex   As Long                     ' シートの番号
5    Dim strFile         As String                   ' Excelファイルの場所
6    Dim xlsAcq          As New Excel.Application    ' 取得側Excel
7    Dim wbAcq           As Workbook                 ' 取得側Excelブック
8    Dim wsAcq           As Worksheet                ' 取得側Excelシート
9    Dim wsSet           As Worksheet                ' 設定側Excelシート
10    Const strPath       As String = "パスを指定する"
11    Set wsSet = ActiveSheet
12    Dim i As Long
13
14    strFile = Dir(strPath & "*.xls")
15    lngRowsNo = 3  ' 書きこみ開始位置(行)
16    Do Until strFile = ""
17        '----- Excelブックを開く
18        Set wbAcq = Workbooks.Open(strPath & strFile)
19
20        '----- シートを検索
21        For lngSheetIndex = 1 To wbAcq.Worksheets.Count
22            '----- 「更新」シートを検索
23            If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
24                '----- 「更新」シートを変数へ登録
25                
26                Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
27                '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
28                With wsAcq
29                Dim fname As String        'ファイル名
30                Dim n As Long                  'ループで使用します。
31                Dim m As Long                  'ループで使用します。
32                Dim ec1 As Long               '各開発の一番下の担当者のセルを取得
33                Dim ec2 As Long               '各開発の 月の一番右（最後）のセルを取得
34                Dim ec3 As Long               '月数を取得
35                Dim ColumnNo As Long    ' 転記先の列番号（初期値４）
36                Dim ColumnNo2 As Long    ' 転記元の列番号（初期値５）＋３されていく
37                
38                ColumnNo = 4
39                ColumnNo2 = 5
40
41                For i = 1 To .UsedRange.Rows.Count
42
43                  If (Left(.Cells(i, 2).Value, 2) = "A1" Or Left(.Cells(i, 2).Value, 2) = "B1" Or Left(.Cells(i, 2).Value, 2) = "C1") And .Cells(i, 2).MergeCells = False Then
44                    
45                    '月を取得して転記
46                    ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1
47                    
48                    For col = 5 To ec2
49                    
50                    '「担当者」の転記
51                        wsSet.Cells(lngRowsNo - 1, 3).Value = .Cells(i + 1, 3).Value
52                        
53                    '「担当者」以降の 「月」の転記
54                        wsSet.Cells(lngRowsNo - 1, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value
55                        
56                        ColumnNo = ColumnNo + 1
57                        ColumnNo2 = ColumnNo2 + 3
58
59                    Next col
60                    
61                    ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
62                     'データの入っているところまでループさせる (その時、開発名を転記)
63                     ec1 = .Cells(i + 3, 2).End(xlDown).Row
64                        For n = i + 3 To ec1
65                        
66                        '担当者が空白の時スキップする
67                        If Cells(n, 3) = "" Then
68                        GoTo NEXT99
69                        End If
70                        
71                            'ファイル名
72                            fname = ActiveWorkbook.Name
73                            wsSet.Cells(lngRowsNo, 1).Value = fname
74                            
75                            '開発
76                            wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
77                            
78                             '担当者
79                            wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value
80                            
81                             '工数
82                            wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
83                            
84                            wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
85                            
86                            wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
87                            
88                            wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
89                            
90                            wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
91                            
92                            wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
93                            
94                            wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
95                            
96                            wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
97                            
98                            wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
99                            
100                            wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
101                            
102                             '１行下へ
103                            lngRowsNo = lngRowsNo + 1
104                            
105NEXT99:
106                        Next n
107                        
108                    End If
109                Next i
110                End With
111               
112                '----- 検索の終了
113                Exit For
114            End If
115        Next lngSheetIndex
116
117        '----- シート参照の解放
118        Set wsAcq = Nothing
119        '----- ブックを閉じる
120        wbAcq.Close Savechanges:=False
121        
122        '----- 次のファイルへ
123        strFile = Dir()
124        
125        
126    Loop
127
128    '----- Excelへの参照の解放
129    Set xlsAcq = Nothing
130    
131    Dim maxrow As Long  '最終行
132    maxrow = wsSet.Cells(Rows.Count, 3).End(xlUp).Row 'C列で最終行を求める
133    For i = 3 To maxrow
134    
135        If wsSet.Cells(i, "C").Value = "担当者" Then
136            wsSet.Cells(i, "A").Value = ""
137            wsSet.Cells(i, "B").Value = ""
138        End If
139    Next
140
141End Sub
142

質問２.xls

質問３.xls

[現状の実行結果]

[実装したい実行結果]

行動規範の内容に同意します

回答1件

ベストアンサー

VBA
1'lngRowsNo = 3 '3行目から
2lngRowsNo = 2 '2行目から

せっかく"RowsNo"　行の番号って名前つけているのに．．．

追記
この手順だけで値の取得ができますよね？

コピー先の開始行は2行目から開始とする。

コピー元のシートを1行目から検索
_1. B列に"A1"or"B1"or"C1"で始まる文字列がある場合、[開発]の値として変数に代入しておく。

_2. C列が4セル結合している場合(.MergeCellsがTrueの時に.MergeArea.Count = 4 の場合)

__2.1. C列に"担当者"という文字列が入っている場合、表のヘッダーとして[年月]の値をコピー先の行へ設定する。

_3. C列が2セル結合している場合(.MergeCellsがTrueの時に.MergeArea.Count = 2 の場合)

__3.1. C列に文字列が入っている場合、表の明細として[担当者][工数]の値をコピー先の行へ設定する。

※コピー先の行へ設定した場合追加なので、コピー先は次の行へ移動

投稿2020/09/26 16:57

編集2020/09/26 19:31

kuma_kuma_

総合スコア2506

icecleam

2020/09/26 17:25

すみません、、上記の内容だとどこをどういう風に修正すれば良いのかがわからないです。。。

kuma_kuma_

2020/09/26 18:03

まずこれを > Dim lngRowsNo As Long ' 書きこむ位置こう直しましょう > Dim lngRowsNo As Long ' 書きこむ位置(行) 15行目の3行目から2行目へ変更 > lngRowsNo = 2　' 書きこみ開始位置(行) とにかくコメントで細かくなんの処理をしているかしっかりと書きだすようにして下さい。そうすればおのずと間違いにも気が付きます。あとできるだけi,j,nなどの簡略した変数名は使わない。初心者の時ほどわからなくなりますから、ちゃんとした名前付けないと。この処理すさまじい偶然で、たまたま"担当者"と”年月”が設定されています。気が付いていますか？ "担当者"という文字が入っているかは.Cells(i, 3).Valueの値で判断付きますチャンと処理を分けましょう。でないと2行目の書き出しがうまくいきません。あと質問２.xlsの1行目から13行目になに書かれているかわからないので判断付かないですよ > ec1 = .Cells(i + 3, 2).End(xlDown).Row > For n = i + 3 To ec1 ここも間違い。これだと"質問２.xls"の"A1"時"年月"が取得できない。多々突っ込みどころ満載ですが...

icecleam

2020/09/26 18:26

丁寧なご回答いただきありがとうございますコードを書く際にはコメントをその都度書くことを意識しようと思います。また変数も簡略化はなるべくせずにつけるようにします。ご助言いただきありがとうございます。＞あと質問２.xlsの1行目から13行目になに書かれているかわからないので判断＞付かないですよすみません、質問２.xlsも質問３.xlsも1行目から13行目は何も記載されていない空白のセルになっています。 .Cells(i, 3).Valueで担当者を取り出す方法は自分で調べているときにも試したのですが（すみません、質問をする際に記載しておくべきでした）、それを利用して[実装したい実行結果]のように、その行を書き出す処理がうまく書けずに悩んでいましたので、そこまで教えていただくことは可能でしょうか。。注文が多くて申し訳ないです。。

icecleam

2020/09/26 21:32 編集

すみません、上記のベストアンサーの実装をする際のコードの書き方が時間をかけてもどうしてもわからずに行き詰ってしまいました。。実装の手がかりを提示してくださったので、こちらをベストアンサーとさせていただき、またコードの書き方について別の質問としてあげさせていただきます。最後まで力及ばず、実装まで完了できず申し訳ありませんでした。

kuma_kuma_

2020/09/27 03:34

何回も質問上げるなら解決済みで閉じないでいただけますか？たったメインの判定5行の処理ですよ？丁寧に答えようと思ったのに．．．

行動規範の内容に同意します