は、私は、テキストファイルを持っている文字列

Question

に特定の単語の前に、前の単語をコピーし、その外観のような...

Blade Runner 2049 http://www.imdb.com/title/tt1856101 

Kingsman: The Golden Circle http://www.imdb.com/title/tt4649466 

The Crucifixion http://www.imdb.com/title/tt4181782/ 

私は、テキストファイルやコピー前の単語にすべての行を「http://www.imdb.com/title」見つけたコードを持っています（映画名）を "http://www.imdb.com/title"の前に置き、Excelセルに貼り付けます。

Sub GetText() 
Dim fName As String, Word1 As String, Word2 As String, i As Long, s As String, st As String 
fName = "C:\Test\test1.txt" 
st = "http://www.imdb.com/title" 
Open fName For Input As #1 
    Do Until EOF(1) 
     Word1 = Word2 
     Input #1, Word2 
     If (Word2 = st & ">") Or (Word2 Like st & "/*") Then 
      If Trim$(Word1) <> "" Then i = i + 1: Cells(i, 1) = Word1 
     ElseIf Word2 Like "* " & st & "/*" Then 
      Word1 = Trim$(Split(Word2)(1)) 
      If Trim$(Word1) <> "" Then i = i + 1: Cells(i, 1) = Word1 
     End If 
    Loop 
Close #1 
End Sub 

ただし、このコードは映画名の最初の単語のみを貼り付けます。完全な映画名を貼り付けるために変更する必要があるのは何ですか？

Answer 1

これを行う簡単な方法は、Split() functionを使用することです。関数の最後に(0)

Sub Test() 

    Dim OrigStr$, YourMovie$ 
    OrigStr = "Kingsman: The Golden Circle http://www.imdb.com/title/tt4649466" 

    YourMovie = Split(OrigStr, " http:")(0) 
    MsgBox YourMovie 

End Sub 

あなたは前あなたの見つけた単語に文字列全体をしたい述べています。逆に、(1)を使用すると、見つかった単語（ "http："）の最初の反復後の文字列、その作品の2番目の繰り返し後の文字列の(2)が必要になることを意味します。

注意： (i)、（Split()、Split()(i)）を使用せずにSplit()を使用してください。このメソッドを使用すると、実際には文字列ではなく配列に値が返されます。あなたは、配列に値を返すようにした場合はここで

は、上記の他の例である：

Sub Test() 

    Dim OrigStr$, OrigStrArr$(), YourMovie$ 
    OrigStr = "Kingsman: The Golden Circle http://www.imdb.com/title/tt4649466" 

    OrigStrArr = Split(OrigStr, " http:") 
    YourMovie = OrigStrArr(0) 
    MsgBox YourMovie 

End Sub 

Answer 2

あなただけ（テストしていない）Excelでファイルを開き、URLの部分を削除することができますように思える。同様に

Workbooks.Open "C:\Test\test1.txt" 
Cells.Replace " http://www.imdb.com/title/*", "", xlPart 

、唯一のURLを取得する：

Cells.Replace "* http://www.imdb.com/title/", "http://www.imdb.com/title/", xlPart 

Answer 3

を、私はそれを解析します

Sub dural() 
    Dim st As String, s As String, MovieName As String 

    st = "http://www.imdb.com/title" 
    s = "Blade Runner 2049 http://www.imdb.com/title/tt1856101" 
    MovieName = "" 

    If InStr(1, s, st) > 0 Then 
     With Application.WorksheetFunction 
      MovieName = Left(s, .Find(st, s) - 1) 
     End With 
    End If 
    MsgBox MovieName 
End Sub 

：ちょうどワークシートのように

Answer 4

この1つは、正規表現を使用しています。

Sub GetText() 
Dim fName As String 
Dim i As Long 
Dim FileContents As String 
Dim collMatches As Collection 
fName = "C:\Test\test1.txt" 
Open fName For Input As #1 
FileContents = Input(LOF(1), 1) 
Close 1 

Set collMatches = GetRegexMatches(FileContents, "^.*(?=http)") 
Debug.Print collMatches.Count 
For i = 1 To collMatches.Count 
    Cells(i, 1) = collMatches(i) 
Next i 
End Sub 

Function GetRegexMatches(inputstring As String, SearchPattern As String, _ 
         Optional boolIgnoreCase As Boolean = True, Optional boolGlobal As Boolean = True, Optional boolMultiline As Boolean = True, _ 
         Optional UniqueMatches As Boolean = False) As Collection 
Dim Regex As Object 
Dim rgxMatch As Object 
Dim rgxMatches As Object 
Dim collMatches As Collection 
Dim collUniqueMatches As Collection 

Set Regex = CreateObject("vbscript.regexp") 
With Regex 
    'search for any integer matches 
    '"\d+" is the same as "[0-9]+" 
    .Pattern = SearchPattern 
    .IgnoreCase = boolIgnoreCase 
    'Find all matches, not just the first 
    .Global = boolGlobal 
    '^ and $ work per-line, not just at begin and end of file 
    .MultiLine = boolMultiline 
    'built-in test for matches 
    Set collMatches = New Collection 
    Set collUniqueMatches = New Collection 
    If .test(inputstring) Then 
     'if matches, create a collection of them 
     Set rgxMatches = .Execute(inputstring) 
     For Each rgxMatch In rgxMatches 
      collMatches.Add rgxMatch 
      On Error Resume Next 
      collUniqueMatches.Add rgxMatch, rgxMatch 
      On Error GoTo 0 
     Next rgxMatch 
    End If 
End With 

If UniqueMatches Then 
    Set GetRegexMatches = collUniqueMatches 
Else 
    Set GetRegexMatches = collMatches 
End If 

Set Regex = Nothing 

End Function