Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18092 / 76732 ←次へ | 前へ→

【64084】Re:セル内の特定(不定長)文字列の転記
発言  かみちゃん E-MAIL  - 10/1/17(日) 11:11 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>メールでの注文フォームを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
1 hits

【64083】セル内の特定(不定長)文字列の転記 GONTA 10/1/17(日) 10:45 質問
【64084】Re:セル内の特定(不定長)文字列の転記 かみちゃん 10/1/17(日) 11:11 発言
【64087】Re:セル内の特定(不定長)文字列の転記 GONTA 10/1/17(日) 16:11 お礼

18092 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free