添加区間詳細メンテナンス校验宏 validateDetailData
This commit is contained in:
root
485
vba_code_kukan_detail_master.txt
Normal file
485
vba_code_kukan_detail_master.txt
Normal file
@@ -0,0 +1,485 @@
|
|||||||
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||||
|
' === G列变化时生成F列下拉列表(匹配冒号左边) ===
|
||||||
|
If Target.Column = 7 And Target.Row >= 7 Then
|
||||||
|
If Target.Count > 1 Then Exit Sub
|
||||||
|
Call MakeFDropdownByG(Me, Target.Row)
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === F列变化时提取冒号左边到G列 ===
|
||||||
|
If Target.Column = 6 And Target.Row >= 7 Then
|
||||||
|
If Target.Count > 1 Then Exit Sub
|
||||||
|
If Trim(Target.Value) <> "" Then
|
||||||
|
Dim fValue As String
|
||||||
|
fValue = Trim(Target.Value)
|
||||||
|
If InStr(fValue, ":") > 0 Then
|
||||||
|
Target.Offset(0, 1).Value = Split(fValue, ":")(0)
|
||||||
|
' Don't trigger MakeFDropdownByG again - it's already set
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === C列变化时填充D、E ===
|
||||||
|
If Target.Column = 3 And Target.Row >= 7 Then
|
||||||
|
If Target.Count > 1 Then
|
||||||
|
' Handle multiple cells
|
||||||
|
Dim cell As Range
|
||||||
|
For Each cell In Target
|
||||||
|
If cell.Column = 3 And cell.Row >= 7 Then
|
||||||
|
If Trim(cell.Value) = "" Then
|
||||||
|
Call ClearRowData(Me, cell.Row)
|
||||||
|
Else
|
||||||
|
Call FillFromKukanMaster(Me, cell.Row)
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next cell
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Trim(Target.Value) = "" Then
|
||||||
|
Call ClearRowData(Me, Target.Row)
|
||||||
|
Else
|
||||||
|
Call FillFromKukanMaster(Me, Target.Row)
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Sub MakeFDropdownByG(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
|
Dim wsKotsu As Worksheet
|
||||||
|
Dim lastRowKotsu As Long
|
||||||
|
Dim k As Long
|
||||||
|
Dim kotsuList As String
|
||||||
|
Dim kotsuA As String
|
||||||
|
Dim kotsuB As String
|
||||||
|
Dim gValue As String
|
||||||
|
Dim fVal As String
|
||||||
|
Dim targetCellF As Range
|
||||||
|
|
||||||
|
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
||||||
|
fVal = Trim(ws.Cells(rowNum, 6).Value)
|
||||||
|
|
||||||
|
' Skip if F already has matching value (prevent loop)
|
||||||
|
If fVal <> "" And InStr(fVal, ":") > 0 Then
|
||||||
|
If Split(fVal, ":")(0) = gValue Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
On Error Resume Next
|
||||||
|
Set wsKotsu = ThisWorkbook.Worksheets("交通機関マスタ")
|
||||||
|
On Error GoTo 0
|
||||||
|
|
||||||
|
If wsKotsu Is Nothing Then Exit Sub
|
||||||
|
If gValue = "" Then Exit Sub
|
||||||
|
|
||||||
|
lastRowKotsu = wsKotsu.Cells(wsKotsu.Rows.Count, "A").End(xlUp).Row
|
||||||
|
|
||||||
|
kotsuList = ""
|
||||||
|
For k = 4 To lastRowKotsu
|
||||||
|
kotsuA = Trim(wsKotsu.Cells(k, 1).Value)
|
||||||
|
kotsuB = Trim(wsKotsu.Cells(k, 2).Value)
|
||||||
|
If kotsuA <> "" Then
|
||||||
|
If kotsuList <> "" Then kotsuList = kotsuList & ","
|
||||||
|
kotsuList = kotsuList & kotsuA & ":" & kotsuB
|
||||||
|
End If
|
||||||
|
Next k
|
||||||
|
|
||||||
|
Set targetCellF = ws.Cells(rowNum, 6)
|
||||||
|
On Error Resume Next
|
||||||
|
targetCellF.ClearContents
|
||||||
|
targetCellF.Validation.Delete
|
||||||
|
On Error GoTo 0
|
||||||
|
|
||||||
|
If kotsuList <> "" Then
|
||||||
|
On Error Resume Next
|
||||||
|
targetCellF.Validation.Add Type:=xlValidateList, Formula1:=kotsuList
|
||||||
|
targetCellF.Validation.IgnoreBlank = True
|
||||||
|
targetCellF.Validation.ShowDropDownWhenSelected = True
|
||||||
|
' Auto select the first matching one
|
||||||
|
For k = 4 To lastRowKotsu
|
||||||
|
If Trim(wsKotsu.Cells(k, 1).Value) = gValue Then
|
||||||
|
targetCellF.Value = gValue & ":" & Trim(wsKotsu.Cells(k, 2).Value)
|
||||||
|
Exit For
|
||||||
|
End If
|
||||||
|
Next k
|
||||||
|
End If
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Sub ImportMasterDetailData()
|
||||||
|
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, vbCrLf)
|
||||||
|
|
||||||
|
If UBound(lines) < 1 Then
|
||||||
|
MsgBox "CSVにデータがありません。", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === Step 3: Collect CSV codes and data (include all columns including コード and 券種) ===
|
||||||
|
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 "有効なコードが見つかりません。", 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列
|
||||||
|
code = CleanCSVField(CStr(dataArray(0)))
|
||||||
|
wsTarget.Cells(writeRow, 3).Value = code
|
||||||
|
|
||||||
|
' CSV col 2-11 -> G-P列
|
||||||
|
If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(dataArray(1)))
|
||||||
|
If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(dataArray(2)))
|
||||||
|
If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(3)))
|
||||||
|
If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(4)))
|
||||||
|
If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(5)))
|
||||||
|
If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(6)))
|
||||||
|
If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(7)))
|
||||||
|
If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(8)))
|
||||||
|
If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(9)))
|
||||||
|
If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(10)))
|
||||||
|
|
||||||
|
' Auto-fill D, E columns from 区間メンテナンス
|
||||||
|
Call FillFromKukanMaster(wsTarget, writeRow, False)
|
||||||
|
|
||||||
|
' G列已有值 → 触发F下拉列表
|
||||||
|
If Trim(wsTarget.Cells(writeRow, 7).Value) <> "" Then
|
||||||
|
Call MakeFDropdownByG(wsTarget, writeRow)
|
||||||
|
End If
|
||||||
|
|
||||||
|
writeRow = writeRow + 1
|
||||||
|
NextLine:
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox writeRow - 7 & " 行を取り込みました。", vbInformation
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function CleanCSVField(ByVal field As Variant) As String
|
||||||
|
If IsEmpty(field) Or IsNull(field) Then
|
||||||
|
CleanCSVField = ""
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim result As String
|
||||||
|
result = Trim(CStr(field))
|
||||||
|
|
||||||
|
If Len(result) >= 2 Then
|
||||||
|
If Left(result, 1) = """" And Right(result, 1) = """" Then
|
||||||
|
result = Mid(result, 2, Len(result) - 2)
|
||||||
|
result = Replace(result, """""", """")
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
CleanCSVField = result
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
|
||||||
|
Dim wsKukan As Worksheet
|
||||||
|
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("区間メンテナンス")
|
||||||
|
|
||||||
|
If wsKukan Is Nothing Then Exit Sub
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
If setG Then
|
||||||
|
ws.Cells(rowNum, 7).Value = "1"
|
||||||
|
Call MakeFDropdownByG(ws, rowNum)
|
||||||
|
End If
|
||||||
|
|
||||||
|
found = True
|
||||||
|
Exit For
|
||||||
|
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
|
||||||
|
ws.Cells(rowNum, 6).Validation.Delete
|
||||||
|
ws.Cells(rowNum, 17).ClearContents ' Q列错误信息
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal isImport As Boolean = False)
|
||||||
|
' 关闭屏幕刷新和事件提升性能
|
||||||
|
Application.ScreenUpdating = False
|
||||||
|
Application.Calculation = xlCalculationManual
|
||||||
|
|
||||||
|
Dim cValue As String
|
||||||
|
Dim jValue As String
|
||||||
|
Dim kValue As String
|
||||||
|
Dim lValue As String
|
||||||
|
Dim mValue As String
|
||||||
|
Dim nValue As String
|
||||||
|
Dim oValue As String
|
||||||
|
Dim pValue As String
|
||||||
|
Dim gValue As String
|
||||||
|
Dim hValue As String
|
||||||
|
Dim iValue As String
|
||||||
|
Dim i As Long
|
||||||
|
Dim lastRow As Long
|
||||||
|
Dim errorMsg As String
|
||||||
|
|
||||||
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
|
If cValue = "" Then
|
||||||
|
ws.Cells(rowNum, 17).Value = ""
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === J列和K列必须为数字（不能为空） ===
|
||||||
|
jValue = Trim(ws.Cells(rowNum, 10).Value)
|
||||||
|
kValue = Trim(ws.Cells(rowNum, 11).Value)
|
||||||
|
|
||||||
|
If jValue = "" Then
|
||||||
|
errorMsg = "J列は必須項目です。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not IsNumeric(jValue) Then
|
||||||
|
errorMsg = "J列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If kValue = "" Then
|
||||||
|
errorMsg = "K列は必須項目です。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not IsNumeric(kValue) Then
|
||||||
|
errorMsg = "K列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === L、M、N、O、P列如果输入必须为数字 ===
|
||||||
|
lValue = Trim(ws.Cells(rowNum, 12).Value)
|
||||||
|
mValue = Trim(ws.Cells(rowNum, 13).Value)
|
||||||
|
nValue = Trim(ws.Cells(rowNum, 14).Value)
|
||||||
|
oValue = Trim(ws.Cells(rowNum, 15).Value)
|
||||||
|
pValue = Trim(ws.Cells(rowNum, 16).Value)
|
||||||
|
|
||||||
|
If lValue <> "" And Not IsNumeric(lValue) Then
|
||||||
|
errorMsg = "L列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If mValue <> "" And Not IsNumeric(mValue) Then
|
||||||
|
errorMsg = "M列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If nValue <> "" And Not IsNumeric(nValue) Then
|
||||||
|
errorMsg = "N列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If oValue <> "" And Not IsNumeric(oValue) Then
|
||||||
|
errorMsg = "O列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If pValue <> "" And Not IsNumeric(pValue) Then
|
||||||
|
errorMsg = "P列には数値を入力してください。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' === G、H、I列联合主键检查重复 ===
|
||||||
|
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
||||||
|
hValue = Trim(ws.Cells(rowNum, 8).Value)
|
||||||
|
iValue = Trim(ws.Cells(rowNum, 9).Value)
|
||||||
|
|
||||||
|
If gValue <> "" And hValue <> "" And iValue <> "" Then
|
||||||
|
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
|
||||||
|
|
||||||
|
For i = 7 To lastRow
|
||||||
|
If i <> rowNum Then
|
||||||
|
If Trim(ws.Cells(i, 3).Value) = cValue Then
|
||||||
|
If Trim(ws.Cells(i, 7).Value) = gValue And _
|
||||||
|
Trim(ws.Cells(i, 8).Value) = hValue And _
|
||||||
|
Trim(ws.Cells(i, 9).Value) = iValue Then
|
||||||
|
errorMsg = "GHI列の組が既に存在します。"
|
||||||
|
ws.Cells(rowNum, 17).Value = errorMsg
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
' 验证通过，清除Q列错误信息
|
||||||
|
ws.Cells(rowNum, 17).Value = ""
|
||||||
|
|
||||||
|
' 恢复设置
|
||||||
|
Application.ScreenUpdating = True
|
||||||
|
Application.Calculation = xlCalculationAutomatic
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
' 按钮调用的宏（验证当前选中行）
|
||||||
|
Sub validateDetailDataButton()
|
||||||
|
Dim rowNum As Long
|
||||||
|
rowNum = ActiveCell.Row
|
||||||
|
|
||||||
|
If rowNum < 7 Then
|
||||||
|
MsgBox "データ行を選択してください。", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Call validateDetailData(ActiveSheet, rowNum)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub ExportMasterDetailData()
|
||||||
|
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 "出力するデータ行がありません。", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim savePath As String
|
||||||
|
savePath = Application.GetSaveAsFilename( _
|
||||||
|
FileFilter:="CSV Files (*.csv), *.csv", _
|
||||||
|
Title:="CSV保存")
|
||||||
|
|
||||||
|
If savePath = "False" Then Exit Sub
|
||||||
|
If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
|
||||||
|
savePath = savePath & ".csv"
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Header: 利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券１(額)/利用額,定期支給期間/券１(枚)/特別料金,特別料金/券２(額),券２(枚),端数(額),特別料金
|
||||||
|
Dim headerList As Variant
|
||||||
|
headerList = Array("利用区間コード", "券種", "コード", "名称", "1箇月運賃/販売額", "定期額/券１(額)/利用額", "定期支給期間/券１(枚)/特別料金", "特別料金/券２(額)", "券２(枚)", "端数(額)", "特別料金")
|
||||||
|
|
||||||
|
' Build CSV
|
||||||
|
Dim csvContent As String
|
||||||
|
Dim j As Long
|
||||||
|
|
||||||
|
For j = 0 To UBound(headerList)
|
||||||
|
If j > 0 Then csvContent = csvContent & ","
|
||||||
|
csvContent = csvContent & headerList(j)
|
||||||
|
Next j
|
||||||
|
csvContent = csvContent & vbCrLf
|
||||||
|
|
||||||
|
' 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 Trim(ws.Cells(r, 3).Value) <> "" Then
|
||||||
|
' CSV col1 -> C列
|
||||||
|
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
|
||||||
|
' CSV col2-11 -> G-P列
|
||||||
|
For j = 7 To 16
|
||||||
|
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
|
||||||
|
Next j
|
||||||
|
csvContent = csvContent & vbCrLf
|
||||||
|
End If
|
||||||
|
Next r
|
||||||
|
|
||||||
|
' 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出力が完了しました。", vbInformation
|
||||||
|
End Sub
|
||||||
Reference in New Issue
Block a user