update Generic Master bas3

This commit is contained in:
updsv7
2026-04-15 10:42:48 +09:00
parent 41ac5eb9ef
commit d89fc2e8b1
12 changed files with 497 additions and 97 deletions

View File

@@ -1,2 +1,21 @@
# vba ## 项目结构
```
vba/
├── 通勤手当テンプレート_案.xlsm - Excel宏文件
├── 通勤手当テンプレート_案.xlsx - Excel模板
├── README.md
└── src/
├── module/ # 公共模块
│ ├── Generic_Master_Common.bas (3KB) - Master 222/223/224 通用
│ ├── Module_Common.bas (3KB) - 通用函数
│ ├── Read_Common.bas (6KB) - CSV读取
│ └── Write_Common.bas (4KB) - CSV写入
└── thisWorkbook/ # 工作簿级代码
├── Kukan_detail_master.bas (12KB) - 区間詳細マスター
├── Master_222.bas (5KB)
├── Master_223.bas (5KB)
├── Master_224.bas (5KB)
├── Master_507.bas (1KB)
└── Master_address.bas (1KB)
```

View File

@@ -0,0 +1,3 @@
"001","JR 東北線","JR 東北線","","JR 東北線","0",""
"002","","","","","",""
"003","山交バス","山交バス","","山交バス","",""
1 001 JR 東北線 JR 東北線 JR 東北線 0
2 002 JR JR JR
3 003 山交バス 山交バス 山交バス

View File

@@ -0,0 +1,3 @@
"1","法第12条第1項 該当","法第12条第1項 該当","",""
"2","法第12条第1項 該当(規則第5条)","法第12条第1項 該当(規則第5条)","",""
"3","法第12条第1項 非該当","法第12条第1項 非該当","",""
1 1 法第12条第1項 該当 法第12条第1項 該当
2 2 法第12条第1項 該当(規則第5条) 法第12条第1項 該当(規則第5条)
3 3 法第12条第1項 非該当 法第12条第1項 非該当

View File

@@ -0,0 +1,12 @@
"10","法第12条第2項第1号","法第12条第2項第1号","","",""
"20","法第12条第2項第2号","法第12条第2項第2号","","",""
"30","法第12条第2項第3号","法第12条第2項第3号","","",""
"31","法第12条第2項第3号。","法第12条第2項第3号 規則第8条の2第1号","","","規則第8条の2第1号"
"32","法第12条第2項第3号","法第12条第2項第3号 規則第8条の2第2号","","","規則第8条の2第2号"
"33","法第12条第2項第3号","法第12条第2項第3号 規則第8条の2第3号","","","規則第8条の2第3号"
"40","法第12条第3項","法第12条第3項","","",""
"41","法第12条第3項第3号","法第12条第3項第3号 規則第8条の3第1号","","","規則第8条の3第1号"
"42","法第12条第3項第3号","法第12条第3項第3号 規則第8条の3第2号","","",""
"50","法第12条第4項","法第12条第4項","","",""
"60","法第12条第5項","法第12条第5項","","",""
"90","非該当","非該当","","",""
1 10 法第12条第2項第1号 法第12条第2項第1号
2 20 法第12条第2項第2号 法第12条第2項第2号
3 30 法第12条第2項第3号 法第12条第2項第3号
4 31 法第12条第2項第3号。 法第12条第2項第3号 規則第8条の2第1号 規則第8条の2第1号
5 32 法第12条第2項第3号 法第12条第2項第3号 規則第8条の2第2号 規則第8条の2第2号
6 33 法第12条第2項第3号 法第12条第2項第3号 規則第8条の2第3号 規則第8条の2第3号
7 40 法第12条第3項 法第12条第3項
8 41 法第12条第3項第3号 法第12条第3項第3号 規則第8条の3第1号 規則第8条の3第1号
9 42 法第12条第3項第3号 法第12条第3項第3号 規則第8条の3第2号
10 50 法第12条第4項 法第12条第4項
11 60 法第12条第5項 法第12条第5項
12 90 非該当 非該当

View File

@@ -0,0 +1,2 @@
"001","○○大学総長","○○大学総長","","","○○大学総長","○ ○ ○ ○","000000","943901","","","","1"
"002","○○大学医療技術短期大学部学長","○○大学医療技術短期大学部学長","","","○○大学医療技術短期大学部学長","○ ○ ○ ○","607300","607300","","","","1"
1 001 ○○大学総長 ○○大学総長 ○○大学総長 ○ ○ ○ ○ 000000 943901 1
2 002 ○○大学医療技術短期大学部学長 ○○大学医療技術短期大学部学長 ○○大学医療技術短期大学部学長 ○ ○ ○ ○ 607300 607300 1

75
src/data/区間.csv Normal file
View File

@@ -0,0 +1,75 @@
利用区間コード,交通機関区分,交通機関名称,利用区間発名,利用区間着名,距離等,運賃,現金の場合の1箇月運賃,連絡,特別料金区分,特別料金の券種,特別料金の負担額
00001,002,,芦川,甲府,22,2233,,,普通,,
00002,002,,井土ヶ谷,甲府,,0,,,普通,,
00003,002,,稲田堤,甲府,,0,,,普通,,
00004,002,,猿橋,甲府,,0,,,普通,,
00005,002,,塩崎,甲府,,0,,,普通,,
00006,002,,塩山,甲府,,0,,,普通,,
00007,002,,岡谷,甲府,,0,,,普通,,
00008,002,,下部温泉,常永,,0,,,普通,,
00009,002,,我孫子,甲府,,0,,,普通,,
00010,002,,茅野,甲府,,0,,,普通,,
00011,002,,久那土,小井川,,0,,,普通,,
00012,002,,狭間,甲府,,0,,,普通,,
00013,002,,金手,甲府,,0,,,普通,,
00014,002,,穴山,甲府,,0,,,普通,,
00015,002,,御茶ノ水,甲府,,0,,,普通,,
00016,002,,御嶽山・目黒,永田町,,0,,,普通,,
00017,002,,広丘,甲府,,0,,,普通,,
00018,002,,甲斐岩間,甲府,,0,,,普通,,
00019,002,,甲斐上野,甲府,,0,,,普通,,
00020,002,,甲斐大和,甲府,,0,,,普通,,
00021,002,,甲府,常永,,0,,,普通,,
00022,002,,高尾,甲府,,0,,,普通,,
00023,002,,国分寺,甲府,,0,,,普通,,
00024,002,,国母,常永,,0,,,普通,,
00025,002,,国母,甲府,,0,,,普通,,
00026,002,,笹子,甲府,,0,,,普通,,
00027,002,,三鷹,塩山,,0,,,普通,,
00028,002,,山梨市,甲府,,0,,,普通,,
00029,002,,市川本町,常永,,0,,,普通,,
00030,002,,指扇,甲府,,0,,,普通,,
00031,002,,若葉台,甲府,,0,,,普通,,
00032,002,,酒折,甲府,,0,,,普通,,
00033,002,,春日居町,甲府,,0,,,普通,,
00034,002,,初狩,甲府,,0,,,普通,,
00035,002,,小井川,甲府,,0,,,普通,,
00036,002,,小淵沢,甲府,,0,,,普通,,
00037,002,,松本,甲府,,0,,,普通,,
00038,002,,常永,甲府,,0,,,普通,,
00039,002,,新座,甲府,,0,,,普通,,
00040,002,,新三郷,甲府,,0,,,普通,,
00041,002,,新宿,常永,,0,,,普通,,
00042,002,,新府,甲府,,0,,,普通,,
00043,002,,聖蹟桜ヶ丘,甲府,,0,,,普通,,
00044,002,,西荻窪,甲府,,0,,,普通,,
00045,002,,西八王子,甲府,,0,,,普通,,
00046,002,,石和温泉,甲府,,0,,,普通,,
00047,002,,代々木,甲府,,0,,,普通,,
00048,002,,代田橋,甲府,,0,,,普通,,
00049,002,,大月,甲府,,0,,,普通,,
00050,002,,池袋,甲府,,0,,,普通,,
00051,002,,潮見~東京,新宿~甲府,,0,,,普通,,
00052,002,,長後,甲府,,0,,,普通,,
00053,002,,長坂,甲府,,0,,,普通,,
00054,002,,東花輪,甲府,,0,,,普通,,
00055,002,,東山梨,甲府,,0,,,普通,,
00056,002,,東山梨→甲府,甲府→常永,,0,,,普通,,
00057,002,,東所沢,甲府,,0,,,普通,,
00058,002,,東船橋,甲府,,0,,,普通,,
00059,002,,東飯能,甲府,,0,,,普通,,
00060,002,,南甲府,甲府,,0,,,普通,,
00061,002,,韮崎,甲府,,0,,,普通,,
00062,002,,柏の葉キャンパス,甲府,,0,,,普通,,
00063,002,,八王子,甲府,,0,,,普通,,
00064,002,,豊田,甲府,,0,,,普通,,
00065,002,,矢川,甲府,,0,,,普通,,
00066,002,,立川,甲府,,0,,,普通,,
00067,002,,竜王,甲府,,0,,,普通,,
00068,002,,飯田橋,甲府,,0,,,普通,,
00069,003,山交バス,甲府駅北口,山梨大学,,0,,,普通,,
00070,002,,白金高輪駅,虎ノ門駅,20,2000,,,普通,,
00071,003,山交バス,新貢川橋南,山梨大学,30,3000,,,普通,,
00072,002,,芦川,甲府,1,2,3,,普通,,
00073,001,交通用具,smart,smart,2222,222,2222,,普通,,
00074,002,,甲府,甲府,22,2222,2222,,普通,,
1 利用区間コード 交通機関区分 交通機関名称 利用区間発名 利用区間着名 距離等 運賃 現金の場合の1箇月運賃 連絡 特別料金区分 特別料金の券種 特別料金の負担額
2 00001 002 JR 芦川 甲府 22 2233 普通
3 00002 002 JR 井土ヶ谷 甲府 0 普通
4 00003 002 JR 稲田堤 甲府 0 普通
5 00004 002 JR 猿橋 甲府 0 普通
6 00005 002 JR 塩崎 甲府 0 普通
7 00006 002 JR 塩山 甲府 0 普通
8 00007 002 JR 岡谷 甲府 0 普通
9 00008 002 JR 下部温泉 常永 0 普通
10 00009 002 JR 我孫子 甲府 0 普通
11 00010 002 JR 茅野 甲府 0 普通
12 00011 002 JR 久那土 小井川 0 普通
13 00012 002 JR 狭間 甲府 0 普通
14 00013 002 JR 金手 甲府 0 普通
15 00014 002 JR 穴山 甲府 0 普通
16 00015 002 JR 御茶ノ水 甲府 0 普通
17 00016 002 JR 御嶽山・目黒 永田町 0 普通
18 00017 002 JR 広丘 甲府 0 普通
19 00018 002 JR 甲斐岩間 甲府 0 普通
20 00019 002 JR 甲斐上野 甲府 0 普通
21 00020 002 JR 甲斐大和 甲府 0 普通
22 00021 002 JR 甲府 常永 0 普通
23 00022 002 JR 高尾 甲府 0 普通
24 00023 002 JR 国分寺 甲府 0 普通
25 00024 002 JR 国母 常永 0 普通
26 00025 002 JR 国母 甲府 0 普通
27 00026 002 JR 笹子 甲府 0 普通
28 00027 002 JR 三鷹 塩山 0 普通
29 00028 002 JR 山梨市 甲府 0 普通
30 00029 002 JR 市川本町 常永 0 普通
31 00030 002 JR 指扇 甲府 0 普通
32 00031 002 JR 若葉台 甲府 0 普通
33 00032 002 JR 酒折 甲府 0 普通
34 00033 002 JR 春日居町 甲府 0 普通
35 00034 002 JR 初狩 甲府 0 普通
36 00035 002 JR 小井川 甲府 0 普通
37 00036 002 JR 小淵沢 甲府 0 普通
38 00037 002 JR 松本 甲府 0 普通
39 00038 002 JR 常永 甲府 0 普通
40 00039 002 JR 新座 甲府 0 普通
41 00040 002 JR 新三郷 甲府 0 普通
42 00041 002 JR 新宿 常永 0 普通
43 00042 002 JR 新府 甲府 0 普通
44 00043 002 JR 聖蹟桜ヶ丘 甲府 0 普通
45 00044 002 JR 西荻窪 甲府 0 普通
46 00045 002 JR 西八王子 甲府 0 普通
47 00046 002 JR 石和温泉 甲府 0 普通
48 00047 002 JR 代々木 甲府 0 普通
49 00048 002 JR 代田橋 甲府 0 普通
50 00049 002 JR 大月 甲府 0 普通
51 00050 002 JR 池袋 甲府 0 普通
52 00051 002 JR 潮見~東京 新宿~甲府 0 普通
53 00052 002 JR 長後 甲府 0 普通
54 00053 002 JR 長坂 甲府 0 普通
55 00054 002 JR 東花輪 甲府 0 普通
56 00055 002 JR 東山梨 甲府 0 普通
57 00056 002 JR 東山梨→甲府 甲府→常永 0 普通
58 00057 002 JR 東所沢 甲府 0 普通
59 00058 002 JR 東船橋 甲府 0 普通
60 00059 002 JR 東飯能 甲府 0 普通
61 00060 002 JR 南甲府 甲府 0 普通
62 00061 002 JR 韮崎 甲府 0 普通
63 00062 002 JR 柏の葉キャンパス 甲府 0 普通
64 00063 002 JR 八王子 甲府 0 普通
65 00064 002 JR 豊田 甲府 0 普通
66 00065 002 JR 矢川 甲府 0 普通
67 00066 002 JR 立川 甲府 0 普通
68 00067 002 JR 竜王 甲府 0 普通
69 00068 002 JR 飯田橋 甲府 0 普通
70 00069 003 山交バス 甲府駅北口 山梨大学 0 普通
71 00070 002 JR 白金高輪駅 虎ノ門駅 20 2000 普通
72 00071 003 山交バス 新貢川橋南 山梨大学 30 3000 普通
73 00072 002 JR 芦川 甲府 1 2 3 普通
74 00073 001 交通用具 smart smart 2222 222 2222 普通
75 00074 002 JR 甲府 甲府 22 2222 2222 普通

View File

@@ -0,0 +1,345 @@
' CSV Header Constants
Private Sub Worksheet_Change(ByVal Target As Range)
' === Fill D, E when C column changes ===
If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range
For Each cell In Target
If Trim(cell.Value) = "" Then
Call ClearRowData(Me, cell.Row)
Else
Call FillFromKukanMaster(Me, cell.Row)
End If
Next
End If
End Sub
Sub FillFromZ1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Dim wsZ1 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim code As String
On Error Resume Next
Set wsZ1 = ThisWorkbook.Worksheets("Z1")
If wsZ1 Is Nothing Then Exit Sub
On Error GoTo 0
code = Trim(ws.Cells(rowNum, 3).Value)
If code = "" Then Exit Sub
lastRow = wsZ1.Cells(wsZ1.rows.Count, 3).End(xlUp).Row
For i = 7 To lastRow
If Trim(wsZ1.Cells(i, 7).Value) = code Then
ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value)
ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value)
ws.Cells(rowNum, 5).Value = Trim(wsZ1.Cells(i, 6).Value)
ws.Cells(rowNum, 6).Value = Trim(wsZ1.Cells(i, 7).Value)
ws.Cells(rowNum, 7).Value = Trim(wsZ1.Cells(i, 9).Value)
If setG Then
ws.Cells(rowNum, 7).Value = "1"
End If
Exit Sub
End If
Next
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
ws.Cells(rowNum, 6).Validation.Delete
ws.Cells(rowNum, 19).ClearContents ' Q column error info
End Sub
Sub M1_Import()
Dim filePath As String
Dim fileDialog As fileDialog
Dim wsTarget As Worksheet
Dim stream As Object
Dim textContent As String
Dim lines As Variant
Dim i As Long
Dim dataArray As Variant
Dim code As String
Dim lastRow As Long
Dim r As Long
' Target this worksheet
Set wsTarget = Me
' === Step 1: Select CSV file ===
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.Filters.Clear
.Filters.Add "CSV Files", "*.csv"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
filePath = .SelectedItems(1)
End With
' === Step 2: Read CSV with Shift-JIS ===
Set stream = CreateObject("ADODB.Stream")
With stream
.Type = 2
.Charset = "shift_jis"
.Open
.LoadFromFile filePath
textContent = .ReadText
.Close
End With
lines = Split(textContent, vbLf)
' === Validate CSV header ===
If UBound(lines) >= 0 And Trim(lines(0)) <> "" Then
Dim csvHeader As String
csvHeader = Trim(lines(0))
' Validate column count
Dim expectedCount As Long
expectedCount = UBound(Split(CSV_HEADER, ",")) + 1
Dim headerFields As Variant
headerFields = Split(csvHeader, ",")
If UBound(headerFields) + 1 <> expectedCount Then
MsgBox "CSV column count mismatch. Expected: " & expectedCount & ", Got: " & UBound(headerFields) + 1, vbExclamation
Exit Sub
End If
End If
' === Clear all data rows before import ===
lastRow = wsTarget.Cells(wsTarget.rows.Count, "C").End(xlUp).Row
If lastRow >= 7 Then
wsTarget.Range("A7:P" & lastRow).ClearContents
End If
If UBound(lines) < 1 Then
MsgBox "No data in CSV.", vbExclamation
Exit Sub
End If
' === Step 3: Collect CSV codes and data ===
Dim csvData As Object
Set csvData = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(lines)
If Trim(lines(i)) = "" Then GoTo NextCsvLine
dataArray = Split(lines(i), ",")
If UBound(dataArray) >= 0 Then
code = CleanCSVField(CStr(dataArray(0)))
If code <> "" Then
' Use unique key: code + "_" + row index to avoid duplicate key error
csvData.Add code & "_" & i, dataArray
End If
End If
NextCsvLine:
Next i
If csvData.Count = 0 Then
MsgBox "No valid code found.", vbExclamation
Exit Sub
End If
' === Step 6: Write CSV data to next available row ===
writeRow = 7
For i = 1 To UBound(lines)
If Trim(lines(i)) = "" Then GoTo NextLine
dataArray = Split(lines(i), ",")
' CSV col 1 -> C column
code = CleanCSVField(CStr(dataArray(0)))
wsTarget.Cells(writeRow, 3).Value = code
' CSV col 2-11 -> G-P column
If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(1)))
If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(2)))
If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(3)))
If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(4)))
If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(5)))
If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(6)))
If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(7)))
If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(8)))
If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 17).Value = CleanCSVField(CStr(dataArray(9)))
If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 18).Value = CleanCSVField(CStr(dataArray(10)))
' Auto-fill D, E columns
Call FillFromKukanMaster(wsTarget, writeRow, False)
' G column has value → trigger F dropdown
writeRow = writeRow + 1
NextLine:
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
End Sub
Sub validate(ByVal ws As Worksheet, ByVal rowNum As Long)
' Check C column not empty
If Trim(ws.Cells(rowNum, 3).Value) = "" Then
ws.Cells(rowNum, 19).ClearContents
Exit Sub
End If
' Check G, H required and numeric (for composite key)
If Trim(ws.Cells(rowNum, 9).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 9).Value) Then
ws.Cells(rowNum, 19).Value = "G column (I) is required and must be numeric"
Exit Sub
End If
If Trim(ws.Cells(rowNum, 10).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 10).Value) Then
ws.Cells(rowNum, 19).Value = "H column (J) is required and must be numeric"
Exit Sub
End If
' Check I (K column) required
If Trim(ws.Cells(rowNum, 11).Value) = "" Then
ws.Cells(rowNum, 19).Value = "I column (K) is required"
Exit Sub
End If
' Check J, K required and numeric
If Trim(ws.Cells(rowNum, 12).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 12).Value) Then
ws.Cells(rowNum, 19).Value = "J column (L) is required and must be numeric"
Exit Sub
End If
If Trim(ws.Cells(rowNum, 13).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 13).Value) Then
ws.Cells(rowNum, 19).Value = "K column (M) is required and must be numeric"
Exit Sub
End If
' Check L-P optional but must be numeric if entered
Dim col As Long
Dim colName As String
Dim colLetter As String
colLetter = "NOPQR"
For col = 14 To 18
If Trim(ws.Cells(rowNum, col).Value) <> "" And Not IsNumeric(ws.Cells(rowNum, col).Value) Then
colName = Mid(colLetter, col - 13, 1)
ws.Cells(rowNum, 19).Value = colName & " column must be numeric"
Exit Sub
End If
Next col
' Check GH composite key duplicate
Dim g As String, h As String
Dim r As Long
Dim lastRow As Long
g = Trim(ws.Cells(rowNum, 9).Value)
h = Trim(ws.Cells(rowNum, 10).Value)
lastRow = ws.Cells(ws.rows.Count, 3).End(xlUp).Row
For r = 7 To lastRow
If r <> rowNum And Trim(ws.Cells(r, 3).Value) = Trim(ws.Cells(rowNum, 3).Value) Then
If Trim(ws.Cells(r, 9).Value) = g And Trim(ws.Cells(r, 10).Value) = h Then
ws.Cells(rowNum, 19).Value = "GH (I,J) combination already exists"
Exit Sub
End If
End If
Next r
' Validation passed
ws.Cells(rowNum, 19).ClearContents
End Sub
' Button macro (Validate selected row)
Sub validateButton()
Dim ws As Worksheet
Dim lastRow As Long
Dim r As Long
Dim errorCount As Long
Set ws = ActiveSheet
lastRow = ws.Cells(ws.rows.Count, "C").End(xlUp).Row
If lastRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastRow
Call validateDetailData(ws, r)
If Trim(ws.Cells(r, 17).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation
End Sub
Sub M1_Export()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastDataRow As Long
lastDataRow = ws.Cells(ws.rows.Count, "C").End(xlUp).Row
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim savePath As String
savePath = Application.GetSaveAsFilename( _
FileFilter:="CSV Files (*.csv), *.csv", _
Title:="Save CSV")
If savePath = "False" Then Exit Sub
If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
savePath = savePath & ".csv"
End If
' Build header from row 5 (columns C, G-P)
Dim csvContent As String
csvContent = Trim(ws.Cells(5, 3).Value)
Dim j As Long
For j = 7 To 16
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
Next j
csvContent = csvContent & vbLf
' Row counter
Dim rowCount As Long
rowCount = 0
' Data: C,G,H,I,J,K,L,M,N,O,P (skip D,E,F)
Dim r As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
' CSV col1 -> C column
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
' CSV col2-11 -> I-R column
For j = 9 To 18
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
Next j
csvContent = csvContent & vbLf
End If
Next r
' Trim trailing empty lines
Do While Right(csvContent, 1) = vbLf
csvContent = Left(csvContent, Len(csvContent) - 1)
Loop
' Write file
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "shift_jis"
stream.Open
stream.WriteText csvContent, 1
stream.SaveToFile savePath, 2
stream.Close
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub

View File

@@ -108,14 +108,6 @@ Sub Validate(ByVal rowNum As Long)
Exit Sub Exit Sub
End If End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 8).Value) hValue = Trim(ws.Cells(rowNum, 8).Value)
If hValue <> "" Then If hValue <> "" Then
@@ -131,6 +123,14 @@ Sub Validate(ByVal rowNum As Long)
End If End If
End If End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents ws.Cells(rowNum, 2).ClearContents
End Sub End Sub

View File

@@ -4,7 +4,7 @@ Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
End Sub End Sub
Sub Z2_Import() Sub Z2_Import()
Call Generic_Master_Import(Me) Call Generic_Master_Import(Me, 5)
End Sub End Sub
Sub Z2_Export() Sub Z2_Export()
@@ -29,7 +29,7 @@ Sub Z2_Export()
Exit Sub Exit Sub
End If End If
Call Generic_Master_Export(Me, 7, lastDataRow) Call Generic_Master_Export(Me, 5, lastDataRow)
End Sub End Sub
Sub Validate(ByVal rowNum As Long) Sub Validate(ByVal rowNum As Long)
@@ -40,7 +40,7 @@ Sub Validate(ByVal rowNum As Long)
' clear C~I columns background color ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9)) Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 7))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
If cValue = "" Then If cValue = "" Then
@@ -100,33 +100,17 @@ Sub Validate(ByVal rowNum As Long)
Exit Sub Exit Sub
End If End If
Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 8).Value) hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 Then If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "H column must be 1 digit" ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
End If End If
@@ -166,5 +150,5 @@ Sub Z2_ToggleAutoFilter()
End Sub End Sub
Sub Z2_AutoFitColumnWidth() Sub Z2_AutoFitColumnWidth()
Call AutoFitColumnWidth(2, 9) Call AutoFitColumnWidth(2, 7)
End Sub End Sub

View File

@@ -4,7 +4,7 @@ Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
End Sub End Sub
Sub Z3_Import() Sub Z3_Import()
Call Generic_Master_Import(Me) Call Generic_Master_Import(Me, 6)
End Sub End Sub
Sub Z3_Export() Sub Z3_Export()
@@ -29,7 +29,7 @@ Sub Z3_Export()
Exit Sub Exit Sub
End If End If
Call Generic_Master_Export(Me, 7, lastDataRow) Call Generic_Master_Export(Me, 6, lastDataRow)
End Sub End Sub
Sub Validate(ByVal rowNum As Long) Sub Validate(ByVal rowNum As Long)
@@ -40,7 +40,7 @@ Sub Validate(ByVal rowNum As Long)
' clear C~I columns background color ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9)) Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 8))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
If cValue = "" Then If cValue = "" Then
@@ -100,37 +100,29 @@ Sub Validate(ByVal rowNum As Long)
Exit Sub Exit Sub
End If End If
Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 8).Value) hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 Then If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "H column must be 1 digit" ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
End If End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents ws.Cells(rowNum, 2).ClearContents
End Sub End Sub
@@ -166,5 +158,5 @@ Sub Z3_ToggleAutoFilter()
End Sub End Sub
Sub Z3_AutoFitColumnWidth() Sub Z3_AutoFitColumnWidth()
Call AutoFitColumnWidth(2, 9) Call AutoFitColumnWidth(2, 8)
End Sub End Sub

View File

@@ -1,41 +1,6 @@
' ====== (507) =======
Sub O2_Import() Sub O2_Import()
Dim filePath As String Call Generic_Master_Import(Me, 13)
Dim lines As Variant
Dim i As Long
Dim writeRow As Long
Set ws = Me
On Error GoTo ErrorHandler
' Step 1: Select CSV file
filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' Step 2: Read CSV and return 2D array
lines = ReadCSVAs2DArrayStrict(filePath, 4, "shift-jis", True)
' Step 3: Clear data rows
Call ClearDataRows(ws, 7, 3)
' Step 4: Import data
writeRow = 7
For i = LBound(lines, 1) To UBound(lines, 1)
If Not isRowEmpty Then
Dim colOffset As Long
For colOffset = 1 To 4
ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset)))
Next colOffset
writeRow = writeRow + 1
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
End Sub End Sub
Sub O2_SortDataRowsByC() Sub O2_SortDataRowsByC()
@@ -47,5 +12,5 @@ Sub O2_ToggleAutoFilter()
End Sub End Sub
Sub O2_AutoFitColumnWidth() Sub O2_AutoFitColumnWidth()
Call AutoFitColumnWidth(3, 5) Call AutoFitColumnWidth(3, 15)
End Sub End Sub