VBA搜索和複製

Question

我正在自動執行我必須做的更新，並且我要編寫的宏的一部分需要填充內容的特定文本。 我有以下類型在同一列文字的數百行的：

ScreenRecording^naushi02^PROCR^10035

PROCR^10635^ScreenRecording^misby01

ScreenRecording^liw03^procr^10046

我已經黑體我需要的文字。我想要用我所需要的替換整個文本，或者將我需要的內容放在下一列，同一行中。

我已經寫了一些工作了60行左右的行，然後才意識到格式有變化。對於主體來說，這一切都是一樣的，這就是爲什麼我一開始並沒有意識到，而且我花了很多時間寫了一些現在沒用的東西......所以我請求專家的幫助。

一旦我從第一行得到所需要的東西，我需要向下移動，直到最後一個條目重複。

我有一些代碼顯然沒有完全工作。

我曾想過在搜索中使用文本'ScreenRecording'以及我無法在鍵盤上找到的特殊字符，然後嘗試從該點複製所有文本幷包括第2個數字字符。我不知道如何做到這一點，如果它能夠工作，或者即使這是一個好主意，但因爲我花了很多時間試圖弄清楚，我需要一些幫助。

在此先感謝

Answer 1

，如果你想更換：

Sub main2() 
    Dim key As String 
    Dim replacementStrng As String 

    key = "ScreenRecording" 
    replacementStrng = "AAA" 
    With Worksheets("mysheet01").columns("A") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter 
     .Replace what:=key & "^*^", replacement:=key & "^" & replacementStrng & "^", LookAt:=xlPart 
     .Replace what:="^" & key & "^*", replacement:="^" & key & "^" & replacementStrng, LookAt:=xlPart 
    End With 
End Sub 

，如果你想將你在下一列需要什麼，而：

Sub main() 
    Dim myRng As Range 

    Set myRng = GetRange(Worksheets("mysheet01").columns("A"), "ScreenRecording^") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter 
    myRng.Offset(, 1) = "value that I need to place in next row" '<--| change the right part of the assignment to what you need 
End Sub 

Function GetRange(rng As Range, key As String) As Range 
    With rng 
     .AutoFilter Field:=1, Criteria1:="*" & key & "*" '<--| apply current filtering 
     If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then '<--| if there are visible cells other than the "header" one 
      With .SpecialCells(xlCellTypeConstants) 
       If InStr(.SpecialCells(xlCellTypeVisible).Cells(1, 1), key & "^") > 0 Then 
        Set GetRange = .SpecialCells(xlCellTypeVisible) '<--|select all visible cells 
       Else 
        Set GetRange = .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).row - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|select visible rows other than the first ("headers") one 
       End If 
      End With 
     End If 
     .Parent.AutoFilterMode = False '<--| remove drop-down arrows 
    End With 
End Function 

Answer 2

如果你總是希望字「ScreenRecording`後返回值，您可以使用下面的函數來進行。

將其包含在SubRoutine如果需要的地方，以取代：

Function SplitScreenRecording(sInput As String) As String 
    Dim a As Variant 

    Const SDELIM As String = "^" 
    Const LOOKUP_VAL As String = "ScreenRecording" 

    a = Split(sInput, SDELIM) 

    If IsError(Application.Match(LOOKUP_VAL, a, 0)) Then 
     SplitScreenRecording = CVErr(2042) 
    Else 
     SplitScreenRecording = a(Application.Match(LOOKUP_VAL, a, 0)) 
    End If 
End Function 

Sub ReplaceInPlace() 
    Dim rReplace As Range 
    Dim rng As Range 

    Set rReplace = Range("A1:A3") 

    For Each rng In rReplace 
     rng.Value = SplitScreenRecording(rng.Value) 
    Next rng 
End Sub