Excel VBA質問箱 IV

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

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


18077 / 76732 ←次へ | 前へ→

【64099】Re:セル内の特定(不定形)文字列の削除
発言  かみちゃん E-MAIL  - 10/1/18(月) 20:38 -

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

>特定の文字列の転記に光が見えてきた

【64083】の質問に関連していると思いますが、

>この一番下の−−−−以下の文字列を削除する方法

前回提示したコードを修正することだけでできます。
以下に全体を示しますが、修正箇所は★の部分です。

Sub Sample1()
 Dim rngData As Range
 Dim lngRows As Long
 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 = InStrRev(ss, vbLf & "−−−−−−−−−−−−−−−−−−−−−−") '★
  If lngPos > 1 Then '★
   ss = Mid(ss, 1, lngPos - 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
  Else '★
    vntData(lngRow, 2) = "内容に""−−−−−−−−−−−−−−−−−−−−−−""がありません" '★
  End If '★
 Next
 rngData.Value = vntData

 MsgBox "処理を終了しました"
End Sub

0 hits

【64094】セル内の特定(不定形)文字列の削除 GONTA 10/1/18(月) 14:54 質問
【64098】Re:セル内の特定(不定形)文字列の削除 Hirofumi 10/1/18(月) 19:43 回答
【64099】Re:セル内の特定(不定形)文字列の削除 かみちゃん 10/1/18(月) 20:38 発言
【64133】Re:セル内の特定(不定形)文字列の削除 GONTA 10/1/21(木) 12:55 お礼

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