以下のマクロを実行すると「現状の実行結果」のように天気が実行されます。
転記元ファイルの担当者に空白があると、同開発のその下の担当者のところで処理が止まってしまいます。(空白を無しにすると正常に実行されるのは確認しています)
処理の途中で空白のセルが存在した時に、今回でいうと「実装したい実行結果」のように、その行だけをスキップして処理を継続させるようにしたいのですが、インターネットなどで調べ、以下の「該当箇所(現状のソースの一部)」でその部分を実装しようとしたのですが、なかなかうまくできないので、教えていただきたいです。
該当箇所(現状のソースの一部)
Macro
'担当者が空白の時スキップする If Cells(n, 3) = " " Then n = n + 1 End If
現状の実行結果
実装したい実行結果
転記元ファイル(質問用.xls)
現状のソース
Macro
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 n = n + 1 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 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
まだ回答がついていません
会員登録して回答してみよう