| |
こんにちは。かみちゃん です。
>特定の文字列の転記に光が見えてきた
【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
|
|
かみちゃん
- 10/1/18(月) 20:38 -
