アクセルデータシステム | MS Access（アクセス）データベースシステムの受託開発

文字列の操作

#1 文字列中の全てのスペースを削除する

使用例

'-----------------------------------------------------------------
'概要   文字列中の全てのスペースを削除
'引数   strData     : 文字列
'返値   文字列のスペースを除いた値を返す
'エラー 入力値
'-----------------------------------------------------------------
Function ALLTRIM(strData As String) As String

    Dim i As Integer

    For i = 1 To Len(strData)
        If Mid(strData, i, 1) <> Space(1) Then      'スペースかどうかの判断をする
            ALLTRIM = ALLTRIM + Mid(strData, i, 1)
        End If
    Next
End Function


Sub 文字列のスペースの削除()
    
    Const strData As String = "  AA  BB  C  C   DD EE   "

    Debug.Print "両端のスペースを削除： [" & Trim(strData) & "] "
    Debug.Print "先頭のスペースを削除： [" & LTrim(strData) & "]"
    Debug.Print "末尾のスペースを削除： [" & RTrim(strData) & "]"
    Debug.Print "全てのスペースを削除： [" & ALLTRIM(strData) & "]"
End Sub


<実行結果>
両端のスペースを削除： [AA  BB  C  C   DD EE] 
先頭のスペースを削除： [AA  BB  C  C   DD EE   ]
末尾のスペースを削除： [  AA  BB  C  C   DD EE]
全てのスペースを削除： [AABBCCDDEE]

>top

#2 文字列中の数字のみを取得する

使用例

'-----------------------------------------------------------------
'概要   文字列中の数字のみを取得する
'引数   strData     : 文字列
'返値   文字列中の数字を返す
'エラー 0
'-----------------------------------------------------------------
Function GETNUM(strData As String) As Long

    Dim i As Integer, strDat As String
    
    strData = StrConv(strData, vbNarrow)
    
    For i = 1 To Len(strData)
        If Mid(strData, i, 1) = Val(Mid(strData, i, 1)) Then
            strDat = strDat + Mid(strData, i, 1)
        End If
    Next
    
    GETNUM = Val(strDat)
End Function


Sub 文字列中の数字のみを取得()

    Debug.Print GETNUM("100歳")
    Debug.Print GETNUM("時速350Km")
    Debug.Print GETNUM("人口１億２千万人")
    Debug.Print GETNUM("\1,234,567,890")
    Debug.Print GETNUM("これは、数字がありません")
End Sub


<実行結果>
 100 
 350 
 12 
 1234567890 
 0

>top

#3 商号の体裁を整える

使用例

'-----------------------------------------------------------------
'概要   商号の体裁を調える
'引数   strData     : 文字列(会社名)
'返値   商号の体裁を調えた会社名を全角で返す
'-----------------------------------------------------------------

Function SHOGO_COV(strData As String) As String

    Dim varList As Variant
    Dim i As Integer

    varList = Array("株式会社", "(株)", "株)", "(株", "��", _
                      "有限会社", "(有)", "有)", "(有", "��", _
                      "合資会社", "(資)", "資)", "(資", _
                      "合名会社", "(名)", "名)", "(名")
        
    strData = StrConv(strData, vbNarrow)

    For i = 0 To 17
        If InStr(1, strData, varList(i)) > 0 Then
        
            Select Case i
            Case 0 To 4
    
                SHOGO_COV = StrConv(Replace(strData, varList(i), "株式会社"), vbWide)
                Exit Function
            Case 5 To 9
    
                SHOGO_COV = StrConv(Replace(strData, varList(i), "有限会社"), vbWide)
                Exit Function
            Case 10 To 13
    
                SHOGO_COV = StrConv(Replace(strData, varList(i), "合資会社"), vbWide)
                Exit Function
            Case 14 To 17
                
                SHOGO_COV = StrConv(Replace(strData, varList(i), "合名会社"), vbWide)
                Exit Function
            End Select
        Else
        
            SHOGO_COV = StrConv(strData, vbWide)
        End If
    Next i
End Function


Sub 商号の体裁を調える()

    Debug.Print SHOGO_COV("ABCDEF")
    Debug.Print SHOGO_COV("�絵HIJKL")
    Debug.Print SHOGO_COV("有)MNOPQR")
    Debug.Print SHOGO_COV("ＳＴＵＶＷＸ（株")
    Debug.Print SHOGO_COV("(資)エービーシーディ")
End Sub


<実行結果>
ＡＢＣＤＥＦ
株式会社ＧＨＩＪＫＬ
有限会社ＭＮＯＰＱＲ
ＳＴＵＶＷＸ株式会社
合資会社エービーシーディ

>top

#4 商号を削除する

使用例

'-----------------------------------------------------------------
'概要   商号を削除する
'引数   strData     : 文字列(会社名)
'返値   商号を除いた会社名を全角で返す
'-----------------------------------------------------------------

Function SHOGO_DEL(strData As String) As String

    Dim varList As Variant
    Dim i As Integer
    
    varList = Array("株式会社", "(株)", "株)", "(株", "��", _
                      "有限会社", "(有)", "有)", "(有", "��", _
                      "合資会社", "(資)", "資)", "(資", _
                      "合名会社", "(名)", "名)", "(名")
                      
    strData = StrConv(strData, vbNarrow)
     
    For i = 0 To 17
        If InStr(1, strData, varList(i)) > 0 Then
            
            SHOGO_DEL = StrConv(Replace(strData, varList(i), Space(0)), vbWide)
            Exit Function
        Else

            SHOGO_DEL = StrConv(strData, vbWide)
        End If
    Next i

End Function


Sub 商号を削除する()

    Debug.Print SHOGO_DEL("ABCDEF")
    Debug.Print SHOGO_DEL("株式会社GHIJKL")
    Debug.Print SHOGO_DEL("有)MNOPQR")
    Debug.Print SHOGO_DEL("ＳＴＵＶＷＸ��")
    Debug.Print SHOGO_DEL("エービーシーディ（株")
End Sub


<実行結果>
ＡＢＣＤＥＦ
ＧＨＩＪＫＬ
ＭＮＯＰＱＲ
ＳＴＵＶＷＸ
エービーシーディ

>top