以下の「現状のソース」を実行すると「転記先(現状の状況)」のように転記が実行されます。
そこで、一通りの天気が終わった後に担当者が「I」もしくは「O」の時にそこから左の「開発」列と「ファイル名」列を何も記載されていない空白のセルに書き換えたい(今回でいうとA10、B10、A15,B15)のですがインターネットで調べてもよくわかりませんので教えていただきたいです。
よろしくお願いします。
現状のソース
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, 3) = "開発A" Or Left(.Cells(i, 2).Value, 3) = "開発B" Or Left(.Cells(i, 2).Value, 3) = "開発C") And .Cells(i, 2).MergeCells = False 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, 2).End(xlDown).Row 56 For n = i + 3 To ec1 57 58 '担当者が空白の時スキップする 59 If Cells(n, 3) = "" Then 60 GoTo NEXT99 61 End If 62 63 'ファイル名 64 fname = ActiveWorkbook.Name 65 wsSet.Cells(lngRowsNo, 1).Value = fname 66 67 '開発 68 wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value 69 70 '担当者 71 wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value 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 98 99NEXT99: 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
回答2件
あなたの回答
tips
プレビュー