投稿/コメントを表示します。

エクセルマクロ・VBA基礎編フォローアップ ベーシック
文字列を加工してデータ転記する(その1)

明石　照伸さんの投稿

(投稿ID: 416)

お世話になります。

上記設問[３]、[４]、[５]について以下回答案作成してみました。
アドバイス等いただけますと幸いです。

よろしくお願いいたします。

＝＝＝設問[３]　ここから＝＝＝

Sub furiwake3()
Dim kugiri1 '文字列の最初の区切り
Dim kugiri2 '文字列の2番目の区切り
Dim nagasa '文字列の長さ
Dim gyo

For gyo = 2 To 51
kugiri1 = InStr(1, Range("e" & gyo).Value, "線")
kugiri2 = InStr(1, Range("e" & gyo).Value, "駅")
nagasa = Len(Range("e" & gyo).Value)

Range("h" & gyo).Value = Left(Range("e" & gyo).Value, kugiri1)
Range("i" & gyo).Value = Mid(Range("e" & gyo).Value, kugiri1 + 1, nagasa - kugiri2 + 1)
Range("J" & gyo).Value = Right(Range("e" & gyo).Value, nagasa - kugiri2)


Next



End Sub
＝＝＝設問[３]　ここまで＝＝＝


＝＝＝設問[４]　ここから＝＝＝

Sub furiwake4()
Dim gyo
For gyo = 2 To 11
Dim kugiri
kugiri = InStr(Range("c" & gyo).Value, "区")

If kugiri > 0 Then
Range("f" & gyo).Value = Left(Range("c" & gyo).Value, kugiri)
Range("g" & gyo).Value = Mid(Range("c" & gyo).Value, kugiri + 1)

Else
kugiri = InStr(Range("c" & gyo).Value, "市")
Range("f" & gyo).Value = Left(Range("c" & gyo).Value, kugiri)
Range("g" & gyo).Value = Mid(Range("c" & gyo).Value, kugiri + 1)

End If

Next



End Sub
＝＝＝設問[４]　ここまで＝＝＝

＝＝＝設問[５]　ここから＝＝＝

Sub furiwake5()

Dim kugiri
Dim gyo

For gyo = 2 To 11
kugiri = InStr(Range("e" & gyo).Value, "線")
If kugiri > 0 Then

Range("h" & gyo).Value = Left(Range("e" & gyo).Value, kugiri)
Range("i" & gyo).Value = Mid(Range("e" & gyo).Value, kugiri + 1)

Else
kugiri = InStr(Range("e" & gyo).Value, "ル")
Range("h" & gyo).Value = Left(Range("e" & gyo).Value, kugiri)
Range("i" & gyo).Value = Mid(Range("e" & gyo).Value, kugiri + 1)

End If

Next



End Sub
＝＝＝設問[５]　ここまで＝＝＝
2014/07/24 08:49