投稿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 ' 転記先の列番号（初期値４） 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件
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 ' 転記先の列番号（初期値４） 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
総合スコア5493
0
ベストアンサー
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
総合スコア5493
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'１行下へ 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
投稿2020/09/21 02:59
編集2020/09/21 03:35
総合スコア27
あなたの回答
tips
プレビュー
Q&A
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2020/09/21 05:46