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
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