Fix FillFromKukanMaster - ensure D,E columns are filled

This commit is contained in:
updsv7
2026-04-13 12:10:43 +09:00
parent f29ea2874b
commit 0162cc677e

View File

@@ -229,8 +229,6 @@ Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional By
Dim lastRow As Long
Dim i As Long
Dim code As String
Dim deValue As String
Dim fgValue As String
On Error Resume Next
Set wsKukan = ThisWorkbook.Worksheets("区間メンテナンス")
@@ -241,38 +239,24 @@ Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional By
code = Trim(ws.Cells(rowNum, 3).Value)
If code = "" Then Exit Sub
lastRow = wsKukan.Cells(wsKukan.Rows.Count, "C").End(xlUp).Row
Dim found As Boolean
found = False
lastRow = wsKukan.Cells(wsKukan.Rows.Count, 3).End(xlUp).Row
For i = 7 To lastRow
If Trim(wsKukan.Cells(i, 3).Value) = code Then
deValue = Trim(wsKukan.Cells(i, 4).Value) & ": " & Trim(wsKukan.Cells(i, 5).Value)
ws.Cells(rowNum, 4).Value = deValue
fgValue = Trim(wsKukan.Cells(i, 6).Value) & "~" & Trim(wsKukan.Cells(i, 7).Value)
ws.Cells(rowNum, 5).Value = fgValue
ws.Cells(rowNum, 4).Value = Trim(wsKukan.Cells(i, 4).Value) & ": " & Trim(wsKukan.Cells(i, 5).Value)
ws.Cells(rowNum, 5).Value = Trim(wsKukan.Cells(i, 6).Value) & "~" & Trim(wsKukan.Cells(i, 7).Value)
If setG Then
ws.Cells(rowNum, 7).Value = "1"
Call MakeFDropdownByG(ws, rowNum)
End If
found = True
Exit For
Exit Sub
End If
Next
If Not found Then
Call ClearRowData(ws, rowNum)
Exit Sub
End If
Call ClearRowData(ws, rowNum)
End Sub
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents