phon2zip()でＢ列を作成して、Ａ列と調整する

保存、検索の調整
i= 0 to
j3.ho--i2

m3.p 削除

range("e1") =zipex(i2)



文字位置の読み込みはCint()にする

PDATA
 PDATA.csv


※ＵＦ１

Private Sub cbCancel_Click()
    
    UF1.Hide
    Unload UF1
    'DSナンバーをクリアして、住所入力へ
    Worksheets("Sheet1").Range("i2").Value = ""
    Worksheets("Sheet1").Range("j11").Value = ""
    Worksheets("Sheet1").Range("j3").Value = ""
    Worksheets("Sheet1").Range("j3").Select
    
End Sub



※selectionchange

    'フリガナ（ＺＩＰ）I2に保存
    If strTargetAddress = "$J$4" Then
        If Range("i2") = "" Then Range("i2").Value = Range("j3").Phonetic.Text
    End If


    '検索
    If strTargetAddress = "$J$14" Then

        'データロード
        If Range("m3").Value = "データ無し" Then
            Call loadCSV
            Range("m3").Value = "データ有り"
        End If




                'fong-possition
                Range("a3").VerticalAlignment = CInt(.Offset(i, 25).Value)
                Range("b3").VerticalAlignment = CInt(.Offset(i, 26).Value)
                Range("c3").VerticalAlignment = CInt(.Offset(i, 27).Value)
                Range("d3").VerticalAlignment = CInt(.Offset(i, 28).Value)
                Range("e3").VerticalAlignment = CInt(.Offset(i, 29).Value)
                Range("f3").VerticalAlignment = CInt(.Offset(i, 30).Value)
                Range("g3").VerticalAlignment = CInt(.Offset(i, 31).Value)
                Range("h3").VerticalAlignment = CInt(.Offset(i, 32).Value)



※ワークブック

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Call SaveCSV
    Worksheets("DS").Range("a1").CurrentRegion.Clear
    
    Worksheets("sheet1").Select
    Range("m3").Value = "データ無し"
    Range("l1").Value = 1
    Range("a1").Select
    Range("j13").Select
    
End Sub




※標準モジュールへ

Public Const strCSVFileName As String = "pdata.csv"


'郵便番号外だし（開発用 c-b）
Public Sub phon2zip()
    Dim i As Long
    For i = 2 To 100
        Range("b" & i).Value = Range("c" & i).Phonetic.Text
    Next

End Sub

'ＣＳＶセーブ
Public Sub SaveCSV()

    Dim strFileName As String
    Dim fso As Object
    Dim TS As Object
    Dim i As Long
    Dim j As Long
    Dim strLine As String
'    Dim strDLMT As String
    Dim rng As Range
    Dim strData() As String
    Dim lngCol As Long
    Dim lngRow As Long
    
    Set rng = Worksheets("DS").Range("a1")
    
    '空白なら処理しない
    If rng.Value = "" Then Exit Sub
    
    strFileName = Application.ActiveWorkbook.Path & "\PDATA\" & strCSVFileName
    

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TS = fso.CreateTextFile(Filename:=strFileName, Overwrite:=True)
  
    lngRow = rng.CurrentRegion.Rows.Count
    lngCol = rng.CurrentRegion.Columns.Count
    ReDim strData(lngCol - 1)
    
    For i = 1 To lngRow
        For j = 1 To lngCol
            strData(j - 1) = rng.Offset(i - 1, j - 1)
        Next j
        strLine = Join(strData, ",")
        TS.WriteLine strLine
    Next i
    
'    For i = 1 To rng.CurrentRegion.Rows.Count
'        strLine = ""
'        strDLMT = ""
'        For j = 1 To rng.CurrentRegion.Columns.Count
'            If strLine <> "" Then strDLMT = ","
'            strLine = strLine & strDLMT & rng.Offset(i - 1, j - 1)
'        Next j
'
'        TS.WriteLine strLine
'    Next
    
    TS.Close
    Set TS = Nothing
    Set fso = Nothing




'CSVロード
Public Sub loadCSV()

    Dim fso As Object
    Dim csvFile As Object
    Dim csvData As String
    Dim splitcsvData As Variant
    Dim i As Integer
    Dim j As Integer
  
    Dim strFileName As String

    
    strFileName = Application.ActiveWorkbook.Path & "\PDATA\" & strCSVFileName
    

    Set fso = CreateObject("Scripting.FileSystemObject")
  
    Set csvFile = fso.OpenTextFile(strFileName, 1)
    
    i = 1
    Do While csvFile.AtEndOfStream = False
        csvData = csvFile.ReadLine
        splitcsvData = Split(csvData, ",")
        j = UBound(splitcsvData) + 1
        Worksheets("DS").Range(Worksheets("DS").Cells(i, 1), Worksheets("DS").Cells(i, j)).Value = splitcsvData
        i = i + 1
    Loop
    
    csvFile.Close
    Set csvFile = Nothing
    Set fso = Nothing

End Sub