|
こんにちは。かみちゃん です。
>メールでの注文フォームをCSVに転換したのですが、その後のデータベース化
>の方法が対応できません。
>どなたか、お助け下さい。
>
>CSV転換された内容
>
> A
> 商品の注文
> キャンペーンの説明・・・・・・・
> ・・(行数不定の不定長文字列)・・・・・・
>1 ・・・・・・・・・・・・・・・・
> □商品名:○○○
> □数量 :○○個
> □お名前:○○○○
> □電話 :○○○○○○○○○○○
> □住所 :○○○○○○○○○○
> お客様コメント
> :○○○○○○○○○○○○
>
> これらの内容が同一セル内に表示の通りの状態であります。
> この様な注文がA列に 連続して入っています。
> この○○の部分を選択して切り出して、B1,C1,D1と各々同一行の別列に
> 転記したいのですが、方法わかる方お教え下さい。
> 「□商品名:」等の:の前までは固定ですのでそれをキーにして改行ま
> でのデータを転記する方法は、無いのでしょうか?
メールでの注文フォームをCSVに転換した
ものをワークシートに取り込んでいるのですか?
それであれば、CSVファイルになっているデータをわざわざワークシートに取り込んでから処理しなくてもできるような気もしますが、
とりあえず、ワークシートにあるデータで処理するならば、以下のような感じでできると思います。
Sub Sample()
Dim rngData As Range
Dim vntData As Variant
Dim lngRow As Long
Dim ss As String
Dim lngPos As String
Dim v As Variant
Dim i As Long
'Listの左上隅セル位置を基準として設定
With ActiveSheet.Cells(1, "A")
'転記結果が6列の場合、1加算して7とする(元データ分を含める)
Set rngData = .Resize(.Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1, 7)
'データを配列に取得(作業列(お客様コメント用)を含む)
vntData = rngData.Resize(, rngData.Columns.Count + 1).Value
End With
For lngRow = 1 To UBound(vntData, 1)
ss = vntData(lngRow, 1)
lngPos = InStr(ss, "□商品名:")
If lngPos > 0 Then
v = Split(Mid(ss, lngPos), vbLf)
If UBound(v) = 6 Then
For i = 0 To UBound(v)
lngPos = InStr(v(i), ":")
If lngPos > 0 Then
vntData(lngRow, i + 2) = Mid(v(i), lngPos + 1)
End If
Next
vntData(lngRow, 7) = vntData(lngRow, 8)
Else
vntData(lngRow, 2) = "項目数が一致しません" & UBound(v)
End If
Else
vntData(lngRow, 2) = "内容に""□商品名:""がありません"
End If
Next
rngData.Value = vntData
MsgBox "処理を終了しました"
End Sub
|
|