hide_kichiの情報

気になる情報を適当にアップしていきます

【VBA】function作成 文字列内の1桁数値に0を付ける(1->01・・・・)

f:id:hide_kichi:20210107154805j:plainf:id:hide_kichi:20210120094422j:plain
大好きな佐野ラーメンです。美味い!!

お題「#この1年の変化


コロナ禍ですが、仕事はテレワークもなく何も変わってません。

収入は減る一方です。

元気だして頑張るしかないです。

外食が少なくなりました。(そば・うどん・ラーメンくらいですかね)

飲みには今は行ってません。(若い時はよくいきましたが・・・・)

若い人気持ちはよくわかりますが、今は我慢です。

人が多いところも行かなくなりました。

最近ショックなのは、駅のショップがここ一か月で4店舗閉店しました。

コロナの影響だと思います。

早くもとの生活に戻りたいですね。

100%は無理かもしれないけれど・・・・・・

でも

笑顔で頑張りましょう!!

                                    

文字列内の1桁数値に0を付けなければいけないことがあったので

プログラミングしました。

忘れそうなので残しておきます。

しかも0を付ける数値は右から最初に見つかった1桁数値のみです。

VBAのソースは以下です。

'ーーーーーーーーーーーーーーーーーーーーーーーー
結果=blk_cnv4("10ABC2X")

'結果は、「10ABC2X」⇒「10ABC02X」

'ーーーーーーーーーーーーーーーーーーーーーーーー
 Function blk_cnv4(ByRef blk_x)
  '

        Dim work_s1 As String
        Dim work_s2 As String
        Dim work_s3 As String
        Dim work_len As Integer    '文字数
        
        Dim str1(20) As String     '1文字ずつ分解 19文字まで
        
        Dim str_1_0(20) As String  '1文字の数字か英字か 数字=0 英字=1
        Dim str2(20) As String       '1文字ずつ分解 19文字まで
        Dim str_nw(20) As String     '1桁の数値を2桁に変換したもの 0-9のみを変換 01は変換しない
                                     '  1->01  2->02  ・・・・・ 01->01  02->02
        
        

         
        work_len = Len(blk_x)
        work_s3 = blk_x
        work_s = blk_x
        '一文字づつ分解
        For i = 1 To work_len
            str1(i) = Mid$(blk_x, i, 1)
            str_nw(i) = Mid$(blk_x, i, 1)
        Next i
        '数字か英字かチェック 数字=0 英字=1
        For i = 1 To work_len
            str2(i) = Mid$(blk_x, i, 1)
            If IsNumeric(str2(i)) = False Then
                str_1_0(i) = 1
            Else
                str_1_0(i) = 0

            End If
            
        Next i
        Dim 文字W As String
        Dim 数字W As String
        Dim 数字W_CNT As Integer
        文字W = ""
        数字W = ""
        数字W_CNT = 0
        
        For i = work_len To 1 Step -1    '逆から確認
             
            If str_1_0(i) = 0 Then    '数字が見つかったら
                For j = i To 1 Step -1
                      If str_1_0(j) = 1 Then '2件目の文字ならば exit
                        GoTo jump300
                      End If
                      数字W_CNT = 数字W_CNT + 1  '数字カウント
                Next j
            Else
                
                文字W = str2(i) & 文字W    '逆から英字列を保管 3D4L -> 文字W="L”
            End If
            
        Next i
        
jump300:
        If 数字W_CNT = 1 Then
          
                                    Select Case Val(str2(j + 1))
                                    Case 1
                                        work_s2 = "01"
                                    Case 2
                                       work_s2 = "02"
                                    Case 3
                                       work_s2 = "03"
                                    Case 4
                                       work_s2 = "04"
                                    Case 5
                                       work_s2 = "05"
                                    Case 6
                                       work_s2 = "06"
                                    Case 7
                                       work_s2 = "07"
                                    Case 8
                                       work_s2 = "08"
                                    Case 9
                                       work_s2 = "09"
                                    End Select
                                    
                                   str_nw(j + 1) = work_s2
                                   work_s1 = ""
                                   For k = 1 To work_len
                                       work_s1 = work_s1 + str_nw(k)
                                   
                                   Next k
                                   
                                   work_s = work_s1
        
        End If
      '  MsgBox blk_x & "->" & work_s
        blk_cnv4 = work_s
    
    End Function

数多くの文字列を手で修正は大変です。

プログラムは一瞬です。