エクセル VBA

Question

エクセルvbaで特定の文字から次の空白行まで貼り付けるという指定方法をご教示ください。

Sub Macro1()
Dim myStr As String
    Dim findStr As String
    Dim findNo As Integer
    myStr = Range("F3")
    findStr = "1. File List:"
    findNo = InStr(myStr, findStr)
    Range("G3") = Right(myStr, Len(myStr) - findNo)
End Sub

Comments

[tatsu99]

1.File List:　の":"は半角で
Product No. ：　の"："は全角ですが
それで間違いないでしょうか。

[m_ao]

すみません。すべて半角です。記載ミスです。

Answer 1

以下のようにしてください。
標準モジュールに登録してください。

'F列の文章から目的の文字列を取り出し、G列へ設定
Public Sub 抽出()
    Dim maxrow As Long
    Dim wrow As Long
    maxrow = Cells(Rows.Count, "F").End(xlUp).Row '最終行を求める
    
    For wrow = 3 To maxrow
        Cells(wrow, "G").Value = MyGetText(Cells(wrow, "F").Value)
    Next

End Sub
'文章から検索ワード1,2の文字列を含む行を取得する
Public Function MyGetText(ByVal str As String) As String
    Const kw1 As String = "1.File List:"        '検索ワード1
    Const kw2 As String = "Product No. :"       '検索ワード2
    Dim arr As Variant
    Dim wstr As String
    Dim find As Boolean
    Dim RegExp As Object
    Dim i As Long
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Pattern = "^[\s　]*$"            '半角空白及び全角空白だけからなる行
    MyGetText = ""
    wstr = Replace(str, vbCrLf, vbLf)       '改行がvbCrLfの場合の保険
    arr = Split(wstr, vbLf, -1, 0)
    If UBound(arr) < 1 Then Exit Function
    find = False
    For i = 0 To UBound(arr)
        If find = False Then
            If Left(arr(i), Len(kw1)) = kw1 Or Left(arr(i), Len(kw2)) = kw2 Then
                find = True
                MyGetText = arr(i) & vbLf
            End If
        Else
            If RegExp.test(arr(i)) = True Then
                Exit For
            End If
            MyGetText = MyGetText & arr(i) & vbLf
        End If
    Next
End Function

Comments

[m_ao]

コードの記載ありがとうございました。抽出することができました。もし今後検索キーワードが増えた場合にもkw3として追加していくことも可能でしょうか。

[tatsu99]

はい。可能です。

[m_ao]

あと少し勉強させてください。
wstr = Replace(str, vbCrLf, vbLf)
arr = Split(wstr, vbLf, -1, 0)
ここでは何を行っているのでしょうか。
またfind = False　とは検索なのでしょうか。

[tatsu99]

>wstr = Replace(str, vbCrLf, vbLf)
上記ですが、改行がvbcrlf(0xD0A)の場合と、vblf(0xA)の場合が考えられます。
vblfを使うのが本来の使い方ですが、まれにvbcrlfに設定してあるケースもあるので、その場合を考量して
vbcrlfをvblfに一旦、置き換えます。
その後
>arr = Split(wstr, vbLf, -1, 0)
によって、vblf（改行）で、文字列を分割します。
つまり、arrには、各行の文字列が格納されます。

>またfind = False　とは検索なのでしょうか。
findはキーワードの文字が出現したかどうかを表すフラグです。
キーワードを検索済みかどうかという意味でfindと名付けましたが、flagという変数名の方が判りやすいかも知れません。
arrの各行を先頭から処理します。arr(0)～arr(N)まで。（Nは最後の行）
findがfalseの場合は、その行がキーワードに一致するか否かを判定し、一致するならfindをtrueにし、その文字を戻り値の文字列に設定します。
findがtrueの場合は、キーワードが出現済みということなので、その行が空白でなければ、戻り値の文字列に追加し続けます。その行が空白なら、処理を打ち切ります。
尚、空白行は、改行以外に、半角スペース、全角スペースから構成される場合も含んでいます。

[m_ao]

色々と教えて頂きありがとうございました。

Answer 2

とりあえず、

1.File List:
BBBBBBBBBBB  V1.0
CCCCCCCCCCCCCCCCCCCCCCCCCC

の部分を取り出すコード例

    Dim myStr As String, FindStr As String
    myStr = Range("F3").Text
    FindStr = "1. File List:"

    Range("G3").Value = FindStr & Split(Split(myStr, FindStr)(1), vbLf & vbLf)(0)

エクセルのセル内の改行は vbLf

追記

上記のコードを踏まえて、汎用関数にすると、

コード1

Public Function ExtractText(myStr As String, FindStr As String) As String
    Dim ary
    ary = Split(myStr, FindStr)
    If UBound(ary) > 0 Then
        ExtractText = FindStr & Split(Split(myStr, FindStr)(1), vbLf & vbLf)(0)
    End If
End Function

これを使って、F列を最後まで、処理するには、ループを使うことになります。
いろいろありますが、For Each を使うと簡潔に記述できます。

コード2

Public Sub Proc1()
    Dim Rng As Range, res As String
    For Each Rng In Range("F3", Range("F2").End(xlDown))
        res = ExtractText(Rng.Text, "1.File List:")
        If res = "" Then
            res = ExtractText(Rng.Text, "Product No. ：")
        End If
        Rng.Offset(, 1).Value = res
    Next
End Sub

説明補足

上記のコード1、コード2をコピーして標準モジュールに貼り付けて、Proc1を実行してください。

Comments

[m_ao]

回答頂きありがとうございました。自分のところで実行したのですが、４行目ExtractText　でコンパイルエラーとなりました。SubまたはFunctionが定義されていません。とのメッセージでした。私のほうでの設定が不足しているようです、どうかご教示ください。

[hatena19]

ExtractText関数は作成してますか。
（回答のコードをコピーして標準モジュールに貼り付ければ使えるようになります。）

[m_ao]

ExtractText関数というのを使用したことが今まで無かったです。よくわからないので作成の仕方を探してみます。

[hatena19]

ExtractText関数はユーザー定義関数です。この回答の下から２つめのコードブロックがそれです。
Public Function ExtractText(myStr As String, FindStr As String) As String
で始まるコードです。
これをコピーして標準モジュールに貼り付けてください。

[m_ao]

コード1を忘れていました。実行してみたのですが、G列には特定の文字から下までが結果として表示されました。もう一度確認してみます。
コメントありがとうございました。

[hatena19]

「空白」というのを改行のみ行と判断してコードを書きましたが、半角空白または全角空白が含まれているのなら、コードを書きなおす必要がありますが、tatsu99さんのコードでできているなら、そちらを使ってください。

[m_ao]

hatena19さん　ありがとうございました。