エクセル VBA

質問

エクセルVBAを使った方法を教えて頂きたいです。

画像参照※○○は商品名であり、それぞれ異なる名前と仮定

画像のように商品名　個数　単価　合計金額　と分けたいです。最後には消費税とどこに送るかといった形でまとめています。
このような分解する前のデータが約１０００件あります。
これをVBAを使ってわけていきたいのです。
画像の通り商品名の後にスペースなしで個数が入ってきたりします。

それから商品名はほぼ毎月固定なので商品名自体のデータはあります。

どうかよろしくお願いします。

回答No.2

ushi2015

こんにちは
こんな感じでも、
Sub test()
　　Dim r As Range
　　Dim t As Range
　　Application.ScreenUpdating = False
　　With Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(-2))
　　　　.Offset(, 6).Resize(, 4).ClearContents
　　　　.Copy Range("G1")
　　End With
　　Set t = Range("G1", Range("G" & Rows.Count).End(xlUp))
　　t.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
　　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
　　　　Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
　　　　"個", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
　　　　TrailingMinusNumbers:=True
　　Columns("H:H").Insert Shift:=xlToRight
　　Set t = Range("G1", Range("G" & Rows.Count).End(xlUp))
　　With t.Offset(, 1)
　　　　.Formula = "=J1/I1"
　　　　.Value = .Value
　　End With
　　For Each r In t
　　　　r.Replace r.Offset(, 1), ""
　　　　r.Offset(, 1) = r.Offset(, 1) & "個"
　　Next
　　Application.ScreenUpdating = True
End Sub
F8キーでステップ実行すれば何をやっているか分かります。
手作業をマクロにしただけみたいなものです。

補足

もうしわけありません。
エラーが出まして先に進めませんでした。

回答No.1

Prome_Lin

「○○15個650 9,750」ですが、商品名に半角の数字を含まない、という前提条件で、以下のマクロを組みました。

もし、「商品名」に半角の数字を含む可能性のある場合は、おっしゃってください、「商品名」のデータベースから読み込んで、処理をする方法を考えますが、その際は、そのデータベースが具体的にどうなっているのか、教えてください（「Ａ」列の何行目から「商品名」の一覧が入っている、など）。

Option Explicit
Sub Test()
Dim c, i, j, o, p As Long
Dim n, m, q, r, s As String
For i = 1 To Range("A1").End(xlDown).Row
s = Cells(i, 1).Value
c = 0
For j = 1 To Len(s)
If Mid(s, j, 1) >= "0" And Mid(s, j, 1) <= "9" Then
c = 1
n = Left(s, j - 1)
p = InStr(s, "個")
m = Mid(s, j, p - j + 1)
o = InStr(s, " ")
q = Mid(s, p + 1, o - p - 1)
r = Mid(s, o + 1)
End If
If c = 1 Then
Exit For
End If
Next j
Cells(i, 7).Value = n
Cells(i, 8).Value = m
Cells(i, 9).Value = q
Cells(i, 10).Value = r
Next i
End Sub

簡単な説明です。

For i = 1 To Range("A1").End(xlDown).Row

「Ａ」列の一番最後まで処理を行います（途中、空白セルがあった場合、その手前の行が、最終行と判断してしまいます）。

s = Cells(i, 1).Value

それぞれの行の「Ａ」列の値（文字）を「s」に代入しています。

For j = 1 To Len(s)

文字列「s」の文字数の分だけ処理を行います。

If Mid(s, j, 1) >= "0" And Mid(s, j, 1) <= "9" Then

１文字ずつ調べて、その１文字が「0」から「9」の間であれば、

n = Left(s, j - 1)

商品名を取得。

p = InStr(s, "個")

「個」という文字が、何文字目にあるか調べています。

m = Mid(s, j, p - j + 1)

個数の取得。

o = InStr(s, " ")

半角スペースが、何文字目か調べています。

q = Mid(s, p + 1, o - p - 1)

単価を取得。

r = Mid(s, o + 1)

合計金額を取得。

Cells(i, 7).Value = n
Cells(i, 8).Value = m
Cells(i, 9).Value = q
Cells(i, 10).Value = r

それぞれの値を、それぞれのセルに書き込んでいます。

補足

早速のご回答有難うございます。

まず商品名の後にスペースなしで個数が入ってくるかどうか。ですが、これはスペースがあったり、無かったりします。そこの規則性はわかりません。ただ、～個の「～」と「個」の間には必ず半角スペースがあります。
つまりパターン(1)「○○15 個 300 45000」
パターン(2)「○○ 15 個 300 45000」
と、このように○○の後に半角スペースが入る入らないはあります。また、スペースは全て半角で入っています。

商品名のデータは別のシート（シート２と仮定）の1セルに1つずつ入っています。この商品名がシート２に約1000個あります。

まとめますと
・スペースは全て半角
・商品名の後のスペースはあったりなかったり
・個数には必ず「～ 個」と数字と文字の間にスペースがある
・商品名はエクセルで一個ずつコピペ可能な状態
・単価と合計金額の間にも必ずスペースがある

です。色々言葉足らずで済みません。