特定の値が含まれている場合に文字列をコピーするためのVBAコード

Question

こんにちは私はコードの編集方法を探していますので、文字列の始まりのフォント色を変える代わりに、ワークシートは、しかし、私はいつも私はそれを編集しようとすると、私はいつもランタイムエラーで終わる。任意の助けをいただければ幸い、ここに私の現在のコードは次のとおりです。

Sub colorText() 

    Dim cl As Range 
    Dim startPos As Integer 
    Dim totalLen As Integer 
    Dim searchText As String 
    Dim endPos As Integer 
    Dim testPos As Integer 

    ' specify text to search. 
    searchText = "(9)" 

    ' loop trough all cells in selection/range 
    For Each cl In Range("A:A") 
     totalLen = Len(searchText) 
     startPos = InStr(cl, searchText) 
     testPos = 0 

     Do While startPos > testPos 
     With cl.Characters(startPos, totalLen).Font 
      .FontStyle = "Bold" 
      .ColorIndex = 3 
     End With 

    endPos = startPos + totalLen 
    testPos = testPos + endPos 
    startPos = InStr(testPos, cl, searchText, vbTextCompare) 
    Loop 

Next cl 

End Sub 

Answer 1

あなたが言ったことによると、私はこれがあなたが探していると思いますか？ あなたが言ったように、検索する文字列内のSearchStringの位置が適切でない場合、現在のコードは実際には意味をなさない。

Sub CopyMatchedValuesToSheet() 
 

 
Dim ws1 As Worksheet, ws2 As Worksheet 
 
Dim LastRowSource As Long, i As Long 
 
Dim SearchString As String 
 
Dim cell As Range 
 

 
Set ws1 = Worksheets("Sheet1") 
 
Set ws2 = Worksheets("Sheet2") 
 

 
SearchString = "2" ' Set SearchString value or use the one below if you want to change it each time 
 

 
'SearchString = Application.InputBox("Give a string", "SearchString", Type:=2) 
 

 
i = 1 
 

 
With ws1 
 
    LastRowSource = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 
 
    
 
    For Each cell In .Range("A1:A" & LastRowSource) ' Change to A2 if it has header 
 
     If InStr(cell.Value, SearchString) > 0 Then 
 
      ws2.Cells(i + 1, 1).Value = cell.Value 
 
      i = i + 1 
 
     End If 
 
    Next cell 
 
End With 
 

 
End Sub

あなたはSheet2のたびにクリアするには、次だけにコードを変更する使用することができます。

Set ws1 = Worksheets("Sheet1") 
Set ws2 = Worksheets("Sheet2") 
ws2.Cells.Clear 

Answer 2

私が正しくあなたの問題をanderstoodしている場合、あなたはちょうどあなたがコピーしたい文字列を作成し、あなたがwanteセルに割り当てる必要があり：

Dim temp as String 
If Not startPos = 0 Then 
    temp = Mid(cl, startPos) 
    Sheets("sheet2").Cells(cl.Row, cl.Column) = temp 
End If