低所得の青色申告個人事業主のブログ

開業から経験で得た情報をお知らせしていきたいと思います。

= グローバル ナビゲーション =

Excel VBA [CrowdWorksの案件を参考に] 文字列にカンマを挿入するマクロ


[ スポンサー リンク ]

CrowdWorks の Excel VBA にあった案件を参考に架空の要件を用意して、段階的にコーディングしてみました。

なお、あくまで参考にして作った要件のため実際の案件とは異なります。

また、筆者は参考にした案件の受注者ではありません。

 

 

 

クラウドワークス(CrowdWorks)

クラウドワークスには Excel VBA の案件があります。

金額が大きいものは異なりますが、手数料20%+消費税を取られるので、実質22%取られます

加えて振込手数料も取られるので、受注金額が少ないとより手取り額が少なくなります。

今回の架空要件より難しいものばかりですが、それでも5,000円という案件(開発者手取りはここから手数料を差し引いた金額になる)など厳しいものが多いです。

Excel VBA 案件はあまりうまみはないですが、他の開発案件でいえば中間業者が5社6社、またはそれ以上入って元の発注金額から開発者が受け取る手取りは50%以下になることも珍しくないので、使ってみる価値はあると思います。

 

要件(その1)

与えられた文字列(A1セル)の文字間に「,(カンマ)」をひとつ挿入します。

(例として、A1セルに「abc123」と入っているとし、「a,bc123」、「abc12,3」などと出力する。)

もう少し詳細な要件は

  • 与えられた文字列にカンマがあっても無視して(カンマを取り除いた文字列として)処理する
  • カンマは文字間に入れ、先頭や末尾には挿入しない(「,abc123」や「abc123,」はNG)
  • 文字列に対してカンマはひとつのみで、複数のカンマを挿入しない(「a,b,c123」や「ab,c1,12」はNG)

A1セルの文字列をもとに、A列の2行目以降に出力していくコードです。

Sub Fill01()
    
    Const C_CHAR_SPECIFIED As String = ","
    
    Dim i As Integer
    Dim intPos As Integer
    Dim strContents As String
    
On Error GoTo Err_Fill01

    '指定文字を取り除く
    strContents = Replace(Cells(1, 1).Value, C_CHAR_SPECIFIED, "")
    
    For i = 1 To Len(strContents) - 1
        '指定文字を挿入する
        Cells(i + 1, 1).Value = fn_insrChar(strContents, C_CHAR_SPECIFIED, i)
    Next i
        
    Exit Sub
    
Err_Fill01:

    MsgBox "予期せぬエラー" & vbCrLf & vbCrLf & "エラーNo=" & Err.Number _
    & " : " & Err.Description, vbCritical, "Fill01"
    
End Sub

出力結果です。

  A
1 abc123
2 a,bc123
3 ab,c123
4 abc,123
5 abc1,23
6 abc12,3

簡単な内容ですが、少しだけ説明します。

元の値にカンマがあった場合に取り除きたいのですが、remove関数のようなものがないので、代わりにreplace関数を使うことで、カンマを取り除いています

コードを省略しましたが、カンマを追加していくために、ユーザー定義関数(プロシージャ)の "fn_insrChar関数" を使用していますので、こちらの記事で確認ください。

account-it-dentist.hatenablog.com

 

要件(その2)

基本的にその1と同じ要件として

  • ひとつだけでなく文字間にひとつ以上の複数のカンマを入れる(「ab,c1,23」や「a,bc,12,3」など)
  • 文字間に入れるカンマはひとつだけ(「a,,bc123」や「abc,,,123」はNG)

を追加、変更します。

その1もそうですが、いくつかアプローチはあると思います。

左の文字間からひとつふたつと次々に追加してカンマを挿入していくロジックもその1と似たロジックで実現できます。

そのため、ひとつずつさらに追加していくとともに、まだカンマ追加していない左側の処理はその1のロジックを適用していく、という方針にします。

f:id:ACC-DNTST:20210514095534p:plain

その2方針

カンマ追加をしていない部分を切り取るために、InStrRev関数を使用します。

解説ではないですが、勘違いしやすポイントを説明した記事はこちらです。

account-it-dentist.hatenablog.com

同じく、A1セルの文字列をもとに、A列の2行目以降に出力していくコードです。

定数宣言はプロシージャレベルからモジュールレベルに変更しています。

Private Const C_CHAR_SPECIFIED As String = ","

Sub Fill02()

    Dim intRow As Integer
    Dim strContents As String
        
On Error GoTo Err_Fill02
       
    '指定文字を取り除く
    strContents = Replace(Cells(1, 1).Value, C_CHAR_SPECIFIED, "")
    
    intRow = 1
    intRow = fn_addCharSeq(strContents, intRow)
    
    Exit Sub
    
Err_Fill02:

    MsgBox "予期せぬエラー" & vbCrLf & vbCrLf & "エラーNo=" & Err.Number _
    & " : " & Err.Description, vbCritical, "Fill02"
            
End Sub

'--------------------------------------------------
'文字列を1文字ずつずらした位置に挿入する
'   引数
'       in_strContents :    対象の文字列
'       in_intRow :         行番号
'   戻り値
'       出力処理した行番号
'--------------------------------------------------
Private Function fn_addCharSeq(in_strContents As String, _
        in_intRow As Integer) As Integer

    Dim i As Integer
    Dim intRLen As Integer
    Dim intRow As Integer
    Dim strContents As String
    Dim strPrifix As String     '文字列挿入処理済み部分
    Dim strRawPart As String    'まだ文字列挿入していない部分
            
On Error GoTo Err_addCharSeq
    
    strContents = in_strContents
    intRow = in_intRow + 1
    
    '最終の文字列挿入位置を取得する
    intRLen = fn_getLenRawPart(strContents, C_CHAR_SPECIFIED)
    If intRLen > 1 Then
        '文字列挿入処理済み部分
        strPrifix = Left$(strContents, Len(strContents) - intRLen)
        'まだ文字列挿入していない部分
        strRawPart = Right$(strContents, intRLen)
        For i = 1 To Len(strRawPart) - 1
            '指定文字を挿入する
            strContents = strPrifix & _
                fn_insrChar(strRawPart, C_CHAR_SPECIFIED, i)
            Cells(intRow, 1).Value = strContents
            intRow = fn_addCharSeq(strContents, intRow)
        Next i
    End If
    
    fn_addCharSeq = intRow
    
    Exit Function
    
Err_addCharSeq:

    MsgBox "予期せぬエラー" & vbCrLf & vbCrLf & "エラーNo=" & Err.Number _
    & " : " & Err.Description, vbCritical, "fn_addCharSeq"
    
End Function

'--------------------------------------------------
'まだ文字挿入していない部分の文字数取得
'   引数
'       in_strOriginal :    対象の文字列
'       in_strRefString :   参照文字列
'   戻り値
'       最後に登場した参照文字列より後ろ(右)にある
'       文字列の文字数を返す
'--------------------------------------------------
Private Function fn_getLenRawPart(in_strOriginal As String, _
        in_strRefString As String) As Integer

    Dim intBasicPnt As Integer
    Dim intLenRight As Integer

    '最後の参照文字列の位置を取得
    intBasicPnt = InStrRev(in_strOriginal, in_strRefString)
    If intBasicPnt = 0 Then
        ' 参照文字列がない場合の戻り値
        fn_getLenRawPart = Len(in_strOriginal)
    Else
        ' 戻り値
        fn_getLenRawPart = Len(in_strOriginal) _
            - intBasicPnt - Len(in_strRefString) + 1
    End If

End Function

出力結果は簡略化して示すと

カンマ1個パターン:

2行目、18行目、26行目、30行目、32行目

カンマ2個パターン:

3行目、11行目、15行目、17行目、19行目、

23行目、25行目、27行目、29行目、31行目

カンマ3個パターン:

4行目、8行目、10行目、12行目、14行目、

16行目、20行目、22行目、24行目、28行目

カンマ4個パターン:

5行目、7行目、9行目、13行目、21行目

カンマ5個パターン:

6行目

以下は出力結果の一部です。

  A
1 abc123
2 a,bc123
3 a,b,c123
4 a,b,c,123
5 a,b,c,1,23
6 a,b,c,1,2,3

 


ご質問は下の 「コメントを書く」 からお願いします。

ExcelVBA全般に関わる質問で、比較的簡単にお答えできるものはできる限り回答したいと思います。

回答を公開でなくメールでやり取りしたいという場合は、その旨記載していただければ非公開で回答することも可能です。

有償での作業依頼は非公開にしますので、条件等をお知らせください。