Public Function tate2yoko(ByVal strAddress As String) As String
'Microsoft Excel専用ワークシート関数
'横書きを縦書きに変換します
'Copyright(C) YAMAMOTO Masaharu 2020

    Dim i As Long
    Dim j As Long

    Dim strStart As String      '最初の'住所の長さ
    Dim blnFirstStop As Boolean '初回改行無視
    Dim blnStop As Boolean      '改行解除中
    Dim blnStopOne As Boolean   '改行解除（次まで）
    Dim strStop As String       '解除トリガー文字
    Dim strTempAdr As String    '結果文字列
    Dim strTempAdrOne As String '編集中の一文字
   
    Dim strCrLfOff As String    '改行ＯＦＦ文字列
   
    strCrLfOff = "0123456789「（"
    
    blnStop = False
    blnStopOne = True
    blnFirstStop = True
    
    '一文字づつループ
    For i = 1 To Len(strAddress)
        
        '対象文字の格納
        strTempAdrOne = Mid(strAddress, i, 1)
        
        '改行ＯＮ
        If blnStop Then
        
            '一文字あとの改行
            If Not blnStopOne Then
                blnStop = False
                blnStopOne = True
            End If
            
            'トリガー文字が数字の場合
            If IsNumeric(strStop) Then
                If Not IsNumeric(strTempAdrOne) Then blnStop = False
            End If

            '一文字あとに改行
            'トリガー文字「
            If StrComp(strStop, "「", vbTextCompare) = 0 Then
                If StrComp(strTempAdrOne, "」", vbTextCompare) = 0 Then blnStopOne = False
            End If
            
            'トリガー文字（
            If StrComp(strStop, "（", vbTextCompare) = 0 Then
                If StrComp(strTempAdrOne, "）", vbTextCompare) = 0 Then blnStopOne = False
            End If
        
        End If
        
        '改行ＯＫなら改行
        If Not blnStop Then
            If blnFirstStop Then
                blnFirstStop = False
            Else
                strTempAdr = strTempAdr & vbCrLf
            End If
        End If
        
        '改行ＯＦＦ
        For j = 1 To Len(strCrLfOff)
            If StrComp(strTempAdrOne, Mid(strCrLfOff, j, 1), vbTextCompare) = 0 Then
                blnStop = True
                strStop = Mid(strCrLfOff, j, 1)
            End If
        Next j
    
        '１文字追加
        strTempAdr = strTempAdr & strTempAdrOne
        
        If Right(strTempAdr, 1) = "-" Or Right(strTempAdr, 1) = "−" Or Right(strTempAdr, 1) = "ー" Or Right(strTempAdr, 1) = "―" Then strTempAdr = Left(strTempAdr, (Len(strTempAdr) - 1)) + "ｌ"

    Next i
    
    tate2yoko = strTempAdr

End Function