VBA マクロで処理中に空白のセルが存在するときのスキップ方法

以下のマクロを実行すると「現状の実行結果」のように天気が実行されます。
転記元ファイルの担当者に空白があると、同開発のその下の担当者のところで処理が止まってしまいます。（空白を無しにすると正常に実行されるのは確認しています）

処理の途中で空白のセルが存在した時に、今回でいうと「実装したい実行結果」のように、その行だけをスキップして処理を継続させるようにしたいのですが、インターネットなどで調べ、以下の「該当箇所（現状のソースの一部）」でその部分を実装しようとしたのですが、なかなかうまくできないので、教えていただきたいです。

該当箇所（現状のソースの一部）

Macro
1                            '担当者が空白の時スキップする
2                            If Cells(n, 3) = " " Then
3                                n = n + 1
4                            End If

現状の実行結果
イメージ説明

実装したい実行結果
イメージ説明

転記元ファイル（質問用.xls）
イメージ説明

現状のソース

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                Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
26                '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
27                With wsAcq
28                Dim fname As String        'ファイル名
29                Dim n As Long                  'ループで使用します。
30                Dim m As Long                  'ループで使用します。
31                Dim ec1 As Long               '各開発の一番下の担当者のセルを取得
32                Dim ec2 As Long               '各開発の 月の一番右（最後）のセルを取得
33                Dim ColumnNo As Long    ' 転記先の列番号（初期値４）
34                Dim ColumnNo2 As Long    ' 転記元の列番号（初期値５）＋３されていく
35                
36                ColumnNo = 4
37                ColumnNo2 = 5
38
39                For i = 1 To .UsedRange.Rows.Count
40
41                    If Left(.Cells(i, 2).Value, 2) = "開発" Then
42                     '月を取得して転記
43                    ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1
44                    For col = 5 To ec2
45                    
46                        wsSet.Cells(2, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value
47                        
48                        ColumnNo = ColumnNo + 1
49                        ColumnNo2 = ColumnNo2 + 3
50                        
51                    Next col
52
53                    ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
54                     'データの入っているところまでループさせる (その時、開発名を転記)
55                     ec1 = .Cells(i + 3, 3).End(xlDown).Row
56                        For n = i + 3 To ec1
57                        
58                            'ファイル名
59                            fname = ActiveWorkbook.Name
60                            wsSet.Cells(lngRowsNo, 1).Value = fname
61                            
62                            '開発
63                            wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
64                            
65                             '担当者
66                            wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value
67                            
68                            '担当者が空白の時スキップする
69                            If Cells(n, 3) = "" Then
70                                n = n + 1
71                            End If
72                            
73                             '工数
74                            wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
75                            
76                            wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
77                            
78                            wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
79                            
80                            wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
81                            
82                            wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
83                            
84                            wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
85                            
86                            wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
87                            
88                            wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
89                            
90                            wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
91                            
92                            wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
93                            
94                             '１行下へ
95                            lngRowsNo = lngRowsNo + 1
96                            
97                        Next n
98                    End If
99                Next i
100                End With
101               
102                '----- 検索の終了
103                Exit For
104            End If
105        Next lngSheetIndex
106
107        '----- シート参照の解放
108        Set wsAcq = Nothing
109        '----- ブックを閉じる
110        wbAcq.Close Savechanges:=False
111        '----- 次のファイルへ
112        strFile = Dir()
113    Loop
114
115    '----- Excelへの参照の解放
116    Set xlsAcq = Nothing
117
118End Sub

回答3件

前回の回答の
ec1 = .Cells(i + 3, 3).End(xlDown).Row
を
ec1 = .Cells(i + 3, 2).End(xlDown).Row
に変えれば、OKです。

一応、こちらで確認したソースを張っておきます。
Const strPath As String = "D:\goo\excel\goo417"
はあなたの環境に合わせてください。

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

投稿2020/09/21 05:34

tatsu99

総合スコア4985

回答へのコメント

icecleam

2020/09/21 05:46

ご回答いただきありがとうございます。上記のソースで無事に実行することができました。長々とお付き合いいただきありがとうございました。

ベストアンサー

GOTO文を使って良いなら、以下のようにしてください。
変更箇所のみ、記述します。
'回答者変更のコメントがあるところが変更箇所です。
尚、空白のセルかどうかは、スペースは1文字あるかどうかではなく、長さ０の文字列かどうかで判断します。
If Cells(n, 3) = " "　ではなく・・・・こちらは実際にスペースが１文字ないと成立しない
If Cells(n, 3) = "" 　とします。・・・通常のなにも書かれていないセルの場合
蛇足ですが、マクロの先頭に
Option Explicit
を付加すると、未定義の変数をエラーにしてくれるので、間違いが少なくなります。
Option Explicit　を付けることを推奨します。
尚、GOTO文を使いたくない場合は、その旨、補足してください。

VBA
1                        For n = i + 3 To ec1
2
3                            '担当者が空白の時スキップする       '回答者変更
4                            If Cells(n, 3) = "" Then            '回答者変更
5                                GoTo NEXT99                     '回答者変更
6                            End If                              '回答者変更
7                            
8                            'ファイル名
9                            fname = ActiveWorkbook.Name
10                            wsSet.Cells(lngRowsNo, 1).Value = fname
11
12                            '開発
13                            wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
14
15                             '担当者
16                            wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value
17
18
19                             '工数
20                            wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
21
22                            wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
23
24                            wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
25
26                            wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
27
28                            wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
29
30                            wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
31
32                            wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
33
34                            wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
35
36                            wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
37
38                            wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
39                             '１行下へ
40                            lngRowsNo = lngRowsNo + 1
41NEXT99:     '回答者変更
42
43                        Next n
44

投稿2020/09/21 03:28

tatsu99

総合スコア4985

回答へのコメント

icecleam

2020/09/21 03:44

ご回答ありがとうございます。今、上記のソースで動作確認したところ担当者Bをスキップすることはできたのですが、処理がなぜか担当者Cで止まってしまい、以降開発Bの担当者が転記されてしまいました。担当者Cの次のDEF・・・と開発Aの担当者分を表示させた後に開発Bを転記させたいのですが、どのように修正すれば良いでしょうか。。実行結果 ----- 質問用.xls 開発A A 2 3 4 4 質問用.xls 開発A C 2 3 4 4 質問用.xls 開発B I 2 3 3 2 質問用.xls 開発B J 2 質問用.xls 開発B K 2 2 質問用.xls 開発B L -------

tatsu99

2020/09/21 03:53

NEXT99: は Next n の直前にありますか。 Next nの後ろになっていませんか。

icecleam

2020/09/21 04:04 編集

はい、今確認しましたが Next n の直前にNEXT99: を記載しておりました。。実行したソースを下記に記載しておきます。ソース ---- Sub sample1() Dim lngRowsNo As Long ' 書きこむ位置 Dim lngSheetIndex As Long ' シートの番号 Dim strFile As String ' Excelファイルの場所 Dim xlsAcq As New Excel.Application ' 取得側Excel Dim wbAcq As Workbook ' 取得側Excelブック Dim wsAcq As Worksheet ' 取得側Excelシート Dim wsSet As Worksheet ' 設定側Excelシート Const strPath As String = "" Set wsSet = ActiveSheet Dim i As Long strFile = Dir(strPath & "*.xls") lngRowsNo = 3 Do Until strFile = "" '----- Excelブックを開く Set wbAcq = Workbooks.Open(strPath & strFile) '----- シートを検索 For lngSheetIndex = 1 To wbAcq.Worksheets.Count '----- 「更新」シートを検索 If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then '----- 「更新」シートを変数へ登録 Set wsAcq = wbAcq.Worksheets(lngSheetIndex) '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい) With wsAcq Dim fname As String 'ファイル名 Dim n As Long 'ループで使用します。 Dim m As Long 'ループで使用します。 Dim ec1 As Long '各開発の一番下の担当者のセルを取得 Dim ec2 As Long '各開発の月の一番右（最後）のセルを取得 Dim ColumnNo As Long ' 転記先の列番号（初期値４） Dim ColumnNo2 As Long ' 転記元の列番号（初期値５）＋３されていく ColumnNo = 4 ColumnNo2 = 5 For i = 1 To .UsedRange.Rows.Count If Left(.Cells(i, 2).Value, 2) = "開発" Then '月を取得して転記 ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1 For col = 5 To ec2 wsSet.Cells(2, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value ColumnNo = ColumnNo + 1 ColumnNo2 = ColumnNo2 + 3 Next col ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し 'データの入っているところまでループさせる (その時、開発名を転記) ec1 = .Cells(i + 3, 3).End(xlDown).Row For n = i + 3 To ec1 'ファイル名 fname = ActiveWorkbook.Name wsSet.Cells(lngRowsNo, 1).Value = fname '開発 wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value '担当者 wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value '担当者が空白の時スキップする '回答者変更 If Cells(n, 3) = "" Then '回答者変更 GoTo NEXT99 '回答者変更 End If '回答者変更 '工数 wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value '１行下へ lngRowsNo = lngRowsNo + 1 NEXT99: Next n End If Next i End With '----- 検索の終了 Exit For End If Next lngSheetIndex '----- シート参照の解放 Set wsAcq = Nothing '----- ブックを閉じる wbAcq.Close Savechanges:=False '----- 次のファイルへ strFile = Dir() Loop '----- Excelへの参照の解放 Set xlsAcq = Nothing End Sub ----

tatsu99

2020/09/21 04:17

For n = i + 3 To ec1・・・この行の直後に、以下の４行がくるようにしてください。 '担当者が空白の時スキップする '回答者変更 If Cells(n, 3) = "" Then '回答者変更 GoTo NEXT99 '回答者変更 End If '回答者変更

icecleam

2020/09/21 04:27

すみません、上記のことを試しても結果は同じでした。念のため、試したソースもまた載せておきます複数回の確認となってしまい、申し訳ありませんソース ---- Sub sample1() Dim lngRowsNo As Long ' 書きこむ位置 Dim lngSheetIndex As Long ' シートの番号 Dim strFile As String ' Excelファイルの場所 Dim xlsAcq As New Excel.Application ' 取得側Excel Dim wbAcq As Workbook ' 取得側Excelブック Dim wsAcq As Worksheet ' 取得側Excelシート Dim wsSet As Worksheet ' 設定側Excelシート Const strPath As String = "" Set wsSet = ActiveSheet Dim i As Long strFile = Dir(strPath & "*.xls") lngRowsNo = 3 Do Until strFile = "" '----- Excelブックを開く Set wbAcq = Workbooks.Open(strPath & strFile) '----- シートを検索 For lngSheetIndex = 1 To wbAcq.Worksheets.Count '----- 「更新」シートを検索 If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then '----- 「更新」シートを変数へ登録 Set wsAcq = wbAcq.Worksheets(lngSheetIndex) '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい) With wsAcq Dim fname As String 'ファイル名 Dim n As Long 'ループで使用します。 Dim m As Long 'ループで使用します。 Dim ec1 As Long '各開発の一番下の担当者のセルを取得 Dim ec2 As Long '各開発の月の一番右（最後）のセルを取得 Dim ColumnNo As Long ' 転記先の列番号（初期値４） Dim ColumnNo2 As Long ' 転記元の列番号（初期値５）＋３されていく ColumnNo = 4 ColumnNo2 = 5 For i = 1 To .UsedRange.Rows.Count If Left(.Cells(i, 2).Value, 2) = "開発" Then '月を取得して転記 ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1 For col = 5 To ec2 wsSet.Cells(2, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value ColumnNo = ColumnNo + 1 ColumnNo2 = ColumnNo2 + 3 Next col ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し 'データの入っているところまでループさせる (その時、開発名を転記) ec1 = .Cells(i + 3, 3).End(xlDown).Row For n = i + 3 To ec1 '担当者が空白の時スキップする '回答者変更 If Cells(n, 3) = "" Then '回答者変更 GoTo NEXT99 '回答者変更 End If '回答者変更 'ファイル名 fname = ActiveWorkbook.Name wsSet.Cells(lngRowsNo, 1).Value = fname '開発 wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value '担当者 wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value '工数 wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value '１行下へ lngRowsNo = lngRowsNo + 1 NEXT99: Next n End If Next i End With '----- 検索の終了 Exit For End If Next lngSheetIndex '----- シート参照の解放 Set wsAcq = Nothing '----- ブックを閉じる wbAcq.Close Savechanges:=False '----- 次のファイルへ strFile = Dir() Loop '----- Excelへの参照の解放 Set xlsAcq = Nothing End Sub ----

tatsu99

2020/09/21 04:44

すみません。回答が誤っていました。担当者が空白の場合、 ec1 = .Cells(i + 3, 3).End(xlDown).Rowの行で、正しい、最後の担当者が取れません。基本的に見直しが必要になります。この回答は取り下げます。失礼しました。

icecleam

2020/09/21 04:51

承知しました。ご確認いただいて、ありがとうございます。スキップ処理の実装は実現することができたので、この場合、こちらをベストアンサーとさせていただいて、また別途で処理が止まってしまう部分の質問をあげさせていただいたほうがよろしいでしょうか。

tatsu99

2020/09/21 05:18

このスレッドで、回答を続けますので、とりあえず、このままにしておいてください。現行の方法は、各開発のグループの最大行を取得し、その行まで処理する方法をとっています。最大行を取得するときに、C列の担当者を参照していますが、空白の担当者があると、最大行が正しく取れません。最大行を取得する方法として、B行のNOを使用することができるなら、簡単な修正で可能です。 NOを使用可能な条件は、以下の全てが成立しないといけませんが、成立するでしょうか。 ①NOに歯抜けがないこと（空白のNOがないこと） ②次の開発XXが出現するまでに、最低１行以上の空行が存在すること。上記が全て成立すれば、NOで最大行を決定可能です。成立しない場合は、ロジックの基本的な見直しが必要になります。

icecleam

2020/09/21 05:23

長時間のご対応をしていただきありがとうございます。上記の内容、承知いたしました。 ①②は満たしております。すみませんが、御助力の程よろしくお願いしたします。

""にスペースが入っているのが気になりました。
" "ではなく、""かと思います。

VBA
1' ""にスペースが入っている
2If Cells(n, 3) = " " Then

以下で動作しますでしょうか？

VBA
1If Cells(n, 3) = "" Then

追記
工数の処理部分を別のサブルーチンに持って行ったほうが良さそうです。

VBA
1'担当者が空白の時スキップする
2If Cells(n, 3) = " " Then
3   n = n + 1
4End If
5
6'工数
7'ここから・・・
8wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
9
10wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
11
12wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
13
14wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
15
16wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
17
18wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
19
20wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
21
22wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
23
24wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
25
26wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
27'ここまでを別のサブルーチンに持ってく。
28
29'１行下へ
30lngRowsNo = lngRowsNo + 1
31
32Next n

以下を試してみてください。

VBA
1'担当者が空白でなければ、工数処理を呼ぶ。
2    If Cells(n, 3) <> "" Then
3        Call 工数処理(wsSet, lngRowsNo, n)
4    End If
5    
6    '１行下へ
7    lngRowsNo = lngRowsNo + 1
8    
9    Next n
10
11End Sub
12
13'例えば、「工数処理」という名前でサブルーチンを作成する。
14Sub 工数処理(wsSet As Worksheet, lngRowsNo As Long, n As Long)
15    wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
16
17    wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
18
19    wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
20
21    wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
22
23    wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
24
25    wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
26
27    wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
28
29    wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
30
31    wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
32
33    wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
34
35End Sub