質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

3回答

36938閲覧

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

icecleam

総合スコア46

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/09/21 02:46

編集2020/09/21 03:09

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

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

該当箇所(現状のソースの一部)

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 ' 転記先の列番号(初期値4) 34 Dim ColumnNo2 As Long ' 転記元の列番号(初期値5)+3されていく 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 '1行下へ 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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

前回の回答の
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 ' 転記先の列番号(初期値4) 36 Dim ColumnNo2 As Long ' 転記元の列番号(初期値5)+3されていく 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 '1行下へ 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

総合スコア5487

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

icecleam

2020/09/21 05:46

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

0

ベストアンサー

GOTO文を使って良いなら、以下のようにしてください。
変更箇所のみ、記述します。
'回答者変更のコメントがあるところが変更箇所です。
尚、空白のセルかどうかは、スペースは1文字あるかどうかではなく、長さ0の文字列かどうかで判断します。
If Cells(n, 3) = " " ではなく・・・・こちらは実際にスペースが1文字ないと成立しない
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 '1行下へ 40 lngRowsNo = lngRowsNo + 1 41NEXT99: '回答者変更 42 43 Next n 44

投稿2020/09/21 03:28

tatsu99

総合スコア5487

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

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 ' 転記先の列番号(初期値4) Dim ColumnNo2 As Long ' 転記元の列番号(初期値5)+3されていく 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 '1行下へ 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・・・この行の直後に、以下の4行がくるようにしてください。 '担当者が空白の時スキップする '回答者変更 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 ' 転記先の列番号(初期値4) Dim ColumnNo2 As Long ' 転記元の列番号(初期値5)+3されていく 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 '1行下へ 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が出現するまでに、最低1行以上の空行が存在すること。 上記が全て成立すれば、NOで最大行を決定可能です。 成立しない場合は、ロジックの基本的な見直しが必要になります。
icecleam

2020/09/21 05:23

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

0

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

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'1行下へ 30lngRowsNo = lngRowsNo + 1 31 32Next n

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

VBA

1'担当者が空白でなければ、工数処理を呼ぶ。 2 If Cells(n, 3) <> "" Then 3 Call 工数処理(wsSet, lngRowsNo, n) 4 End If 5 6 '1行下へ 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

投稿2020/09/21 02:59

編集2020/09/21 03:35
tomiieee

総合スコア27

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

icecleam

2020/09/21 03:05

ご回答ありがとうございます。 今、動作確認してみたのですが、「現状の実行結果」と同じでした。。。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問