updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix FillFromKukanMaster - ensure D,E columns are filled

Browse Source
This commit is contained in:
updsv7
2026-04-13 12:10:43 +09:00
parent f29ea2874b
commit 0162cc677e
1 changed files with 6 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
vba_code_kukan_detail_master.txt
View File

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