マクロについて

質問

初めて投稿します。

最近、マクロを初めて全くの初心者です。
一応わからない事はネットで検索してたりしていますが
自分が求めているようなプログラミングは可能かどうか皆にお尋ねします。

リストにこういったものが記載されています。

地産　　　　品物　　数量　
鹿児島　　　鶏v　　　　1
東京　　　　 鶏v2 　　　 3
北海道　　　鶏ｂ　　　　7

これを下の図にマクロで自動的に作成させるようにしたいです。
地産　　　　品物　　種類　　数量　
鹿児島　　　鶏　　　　ｖ　　　　1
東京　　　　 鶏　 　ｖ2　　 　　3
北海道　　　鶏　　　　ｂ　　　　7

種類によってｖ、ｖ2、ｂとあるように文字数が違ってきてそれを抽出する為に
条件を用いてプログラミングすることは可能でしょうか？
関数などで抽出は一応出来ますが、この他にも作業を含んでおり
1から最後までマクロで完了させたいと思っております。

急ぎではありませんので、宜しくお願い致します。

回答No.1

hige_082 · ベストアンサー

これでよい？
リストがSheet1にあるとして
Sheet2へ作成します

Sub test()
Dim i As Long
Dim WS1 As Worksheet
Set WS1 = Worksheets("sheet1")
For i = 2 To WS1.Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = WS1.Cells(i, 1).Value
.Offset(, 1).Value = Left(WS1.Cells(i, 2).Value, 1)
.Offset(, 2).Value = Right(WS1.Cells(i, 2).Value, Len(WS1.Cells(i, 2).Value) - 1)
.Offset(, 3).Value = WS1.Cells(i, 3).Value
End With
Next
End Sub

お礼

上の回答との組み合わせで自分の思っていたものが出来そうです。
参考にさせていただきたいと思います。
回答有難うございました。

補足

やってみましたらうまくいきました。
品質の文字数が多くても問題ありませんでした。
どうして分離が出来るのか詳しく教えて頂けませんでしょうか？

回答No.2

hana-hana3

どんな条件か解りませんが、分離に関して作成してみました。

Sub test()

Dim i As Integer
Dim x As Integer
Dim sStr As String
Dim sStr1 As String
Dim sStr2 As String
Dim Ary As Variant

Ary = Array("鶏", "牛", "河童")
'MsgBox Ary(0)

For i = 1 To 5
sStr = Cells(i, 1)
x = 0
Do While x <= UBound(Ary)
sStr1 = Ary(x)
If InStr(sStr, sStr1) = 1 Then
Exit Do
End If
x = x + 1
Loop

sStr2 = Right(sStr, Len(sStr) - Len(sStr1))

Cells(i, 2) = sStr1
Cells(i, 3) = sStr2

Next

End Sub

お礼

返信が遅くなり申し訳ありませんでした。
回答有難うございます。
参考にさせていただきたいと思います。

補足

やってみましたのですが、何故か品物の一覧が河童で埋め尽くされてしまいました。
私の方法が間違ってましたでしょうか？