部分一致が複数のシートに達したときに文字列全体を検索して置き換えます。

Question

Excel VBAで新しく、次に部分一致が複数のシートに達したときに文字列全体を検索して置換するコードを記述します。

検索式を使用してセル内を検索していますが、表示されている値を変更する必要があります。

私が検索して交換したいアイテムは、すべて別のシートの列にあります。私はもっ​​と説明するために写真を提供しました。

私はそれは私がそう任意の提案やヘルプは素晴らしいだろうな何かを思い付くためにそのハード新なってされて

'Replace the whole string when a partial match is achieved 
'find -findobj = sheet.find 
'if find finds - does findobj have data 
'replace in findobj 
'Replace the whole string when a partial match is achieved 

ようになるはずと信じています。 （ちょうどそれがターゲットと何枚に変更すること何にFor x = 2 To 3を変更）

Answer 1

この答えは、最初のシートのセルを使用する第2および第3のシート内のセルに対してそれらを確認してください。今後の参考のために

Sub PartialReplace() 
Dim wsO As Worksheet, wsX As Worksheet 
Dim x As Long 
Dim cell1 As Range, cell2 As Range 
Dim rng1 As Range, rng2 As Range 

'set original worksheet as first sheet 
Set wsO = ActiveWorkbook.Sheets("Sheet1") 

'set range to find values from 
Set rng1 = NonBlankCells(wsO) 

'loop through all cells to find values from 
For Each cell1 In rng1 

    'loop through 2nd and 3rd sheets 
    For x = 2 To 3 

     Set wsX = ActiveWorkbook.Sheets(x) 

     'find all cells to check on sheet being checked 
     Set rng2 = NonBlankCells(wsX) 

     'loop through all cells on sheet being checked 
     If Not rng2 Is Nothing Then 
      For Each cell2 In rng2 

       'if partial match, replace cell value 
       If cell2.Text Like "*" & cell1.Text & "*" Then 
        cell2.Value = cell1.Value 
       End If 

      Next cell2 
     End If 

     Set rng2 = Nothing 

    Next x 

Next cell1 

Set rng1 = Nothing 

End Sub 

Function NonBlankCells(ws As Worksheet) As Range 
Dim ct1 As Long, ct2 As Long 

On Error Resume Next 
ct1 = ws.Cells.SpecialCells(xlCellTypeConstants).Count 
ct2 = ws.Cells.SpecialCells(xlCellTypeFormulas).Count 
On Error GoTo 0 

If ct1 > 0 And ct2 = 0 Then 
    Set NonBlankCells = ws.Cells.SpecialCells(xlCellTypeConstants) 
ElseIf ct1 = 0 And ct2 > 0 Then 
    Set NonBlankCells = ws.Cells.SpecialCells(xlCellTypeFormulas) 
ElseIf ct1 > 0 And ct2 > 0 Then 
    Set NonBlankCells = Union(_ 
    ws.Cells.SpecialCells(xlCellTypeFormulas), _ 
    ws.Cells.SpecialCells(xlCellTypeConstants)) 
End If 

End Function 

、あなたが試してみた何も表示せずに質問を投稿すると、通常は閉鎖されている問題につながることを覚えておいてください：https://stackoverflow.com/help/mcveを参照してください。