さまざまなテキストを見つけて隣接するセルにコピーする

Question

ここに私の最初の記事があります。私はプログラマではありませんが、皆さんが助けてくれることを願っています！

私は、セルのテキストに含まれる本の特定の章をすべて参照する300個のセルのリストを持っています。各セルの内容は様々ですが、私が抽出する必要があるコンテンツは一貫してこの形式です：

"... A01：The Bluesの歴史"にあります。

"...第D27章：The Bluesの多くの顔で見つけることができます。"

章番号のテキスト "A01"や "D27"などを抽出し、そのテキストが見つかった場所の隣のセルにコピーしたいとします。

セルでは、コピーしたいチャプタ番号の前に常に「チャプタ」という単語とスペースがあり、常にコロンが続きます。

私は数時間フォーラムを検索しています。あなたはすでに、VBを使って別のセルに正確なテキストマッチを見つけたり、コピーしたり貼り付けたりする方法を理解してくれました。これは有望に見えましたが、私のために細部を修正してそれがうまくいくようにする方法はわかりません！

Copy part of cells that varies in both length and content using VBA

あなたは私を与えることができます任意の助けてくれてありがとう！

Answer 1

テキストがセルA1にある場合は、B1にこの数式を貼り付けるは：

=MID(A1,SEARCH("Chapter ",A1)+8,3) 

その後、B2にB1をコピーすることができます：B100がaswellを抽出すること。

Answer 2

ここにVBAコードがあります。私はあなたのデータがRange("A1:A300")であると仮定しています。どのような他の人が言っていることは事実ですが

Sub ExtractChapter() 
Dim Data As Range, RowData As Long, Text As String, Chapter As String 

Set Data = Range("A1:A300")  'Change this depends on your data located 
RowData = Data.Rows.Count 
For i = 1 To RowData 
    Text = Data(i) 
    Chapter = Mid$(Text, InStr(Text, ":") - 3, 3) 
    Data(i).Offset(0, 1) = Chapter 
Next 
End Sub 

Answer 3

、ここworks.Thisはあなたの章では、以上の3つの文字が長い（可変の章であっても動作するものがある（あなたは本当にこのためのVBAマクロを必要としません）数字テキストの長さ）。

Sub SEFindStrings() 

Dim searchRange As range 

'wherever your search range is, modify. Mine started at B4 so I used that as the start 
'cell and in my Cells method I used "B". Change so it fits your data 
Set searchRange = range("B4", Cells(Rows.count, "B").End(xlUp)) 

Dim myCell As range 
Dim locationStart As Integer 
Dim locationEnd As Integer 
Dim keyWords As String 

keyWords = "can be found in Chapter " 

'Goes through, and if the cell isn't empty it finds the phrase 'can be found in Chapter ' 
'and then gets the next three characters. 
For Each myCell In searchRange 
    If myCell.Value <> "" Then 
    locationStart = InStr(myCell.Value, keyWords) 
     If locationStart <> 0 Then 
     locationEnd = InStr(locationStart, myCell.Value, ":") - 1 
      myCell.Offset(0, 1).Value = (Mid(myCell.Value, _ 
      (locationStart + Len(keyWords)), locationEnd - Len(keyWords))) 
     End If 
    End If 
Next myCell 


End Sub