| |
こんにちは。かみちゃん です。
>メールでの注文フォームをCSVに転換したのですが、その後のデータベース化
>の方法が対応できません。
>どなたか、お助け下さい。
>
>CSV転換された内容
>
> Ａ
> 商品の注文
> キャンペーンの説明・・・・・・・
> ・・（行数不定の不定長文字列）・・・・・・
>１ ・・・・・・・・・・・・・・・・
> □商品名：○○○
> □数量 ：○○個
> □お名前：○○○○
> □電話 ：○○○○○○○○○○○
> □住所 ：○○○○○○○○○○
> お客様コメント
> ：○○○○○○○○○○○○
>
> これらの内容が同一セル内に表示の通りの状態であります。
> この様な注文が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
|
|
かみちゃん
- 10/1/17(日) 11:11 -
