見出し画像

【VBA】【没コード集】VBAで、文字列を特定文字で置換して、その後、特定文字で分割して、配列に突っ込んで、利用するまで。

ムジン #IT業務改善＆ネットショップ運営改善やってます

お世話になっております。
合同会社ムジンケイカクプロ、代表=ムジンさんの作業メモでございます。

超限定的に役立つVBAでございます。
広報ブログに載せるのもどうも違うので、どなたかに役立てばと思っております。
以下抜粋

"
小田原 Ｆ２

2/16チャレンジ2着10.2[映像]
2/17チャレンジ7着10.2[映像]
2/18チャレンジ3着10.1[映像]

"
'↑「.Cells(i, 29)」のセルに入っている内容。

'変数の宣言　バグを見つけるのに役立つので、職場でちょっと片手間で作る時も入れた方がいい。
Dim str As String

'一旦セルの内容を配列に格納
CheckCell = .Cells(i, 29)

'映像の単語がいらないので、置換命令で空白にして消してしまう。
CheckCell = Replace(CheckCell, "[映像]", "")

'改行コード「vbLf」を基準に分割して、そのまま配列に。
arr = Split(CheckCell, vbLf)

'ここまで書いてあって、現実的な利用方法の具体例がないサイトも多いので以下。

'単純に確認用
str = arr(1) & arr(3) & arr(4) & arr(5)

'iには行数が入っている。47は列数。
.Cells(i, 47) = arr(1)
.Cells(i, 48) = arr(3)
.Cells(i, 49) = arr(4)
.Cells(i, 50) = arr(5)

'配列の内容を、各セルに分散して転記している
'ユーザー定義関数を呼び出す。自前で作ったプログラムを使いやすくしたということ。
Call split_str(TargetSheet, i, 47)
'Functionにしてあるのは、Excelのマクロ実行窓で、一覧に出てこないからすっきりする。
Function split_str(TargetSheet, i, j)

   Dim str As String
   With TargetSheet

       CheckCell = .Cells(i, j)
       
       If CheckCell = "0" Then
       
       ElseIf Len(CheckCell) >= 3 Then
       
           CheckCell = Replace(CheckCell, "[映像]", "")
           arr = Split(CheckCell, vbLf)
   
           str = arr(1) & arr(3) & arr(4) & arr(5)
           
           .Cells(i, j) = arr(1)
           .Cells(i, j+1) = arr(3)
           .Cells(i, j+2) = arr(4)
           .Cells(i, j+3) = arr(5)
           
       Else
       
       End If

   End With
End Function

#企業内でVBAをご利用の場合

経験が浅い方は特に、経験上動けばいいだけだと思うのですが、コピペする前に、一行ずつよーく見て貼り付けてください。

#コピペする前に

プログラミング知識は、私もトップレベルとは言い難いのですが、会社の規模に関わらず、実現したいことが明確化してあれば、初心者でもなんとかなります。
このやりたいことを明確化は、別投稿で書かせていただきます。

#どこかへVBAツールを外注を検討されている場合

うまい人はもっと上手いので、これを基準にこれ以上の方と契約されるといいでしょう。
弊社の上手いの観点は、これよりパッと見で、綺麗に書けているということです。

#修正版 

'対象シート、行数、処理したいセル、転記したい始まりの列
Call split_str(TargetSheet, i, 29, 47)
Call split_str(TargetSheet, i, 30, 51)   
Function split_str(TargetSheet, i, j, k)
   Dim str As String
   With TargetSheet
       CheckCell = .Cells(i, j)
       
       If CheckCell = "0" Then
       
       ElseIf Len(CheckCell) >= 3 Then
       
           CheckCell = Replace(CheckCell, "[映像]", "")
           arr = Split(CheckCell, vbLf)
   
           str = arr(1) & arr(3) & arr(4) & arr(5)
           
           'iには行数が入っている。例えば、47列目から、4列横に分割して転記している。
           .Cells(i, k) = arr(1)
           .Cells(i, k + 1) = arr(3)
           .Cells(i, k + 2) = arr(4)
           .Cells(i, k + 3) = arr(5)
           
       Else
       
       End If
   End With
End Function

いつもお読みいただき、ありがとうございます。 書くだけでなく読みたいので、コメント欄で記事名入れてもらうと見に行きます。