VBA поиск и копия

Question

Я автоматизирую обновление, которое мне нужно сделать, и часть макроса, который я хочу написать, требует определенного текста из того, что заполняется. У меня есть следующие типы текста в том же столбце сотни строк:

ScreenRecording^naushi02^procr^10035

procr^10635^ScreenRecording^misby01

ScreenRecording^liw03^procr^10046

У меня bold Текст, который мне нужен. Я хочу либо заменить весь текст на то, что мне нужно, либо разместить то, что мне нужно, в следующем столбце, в той же строке.

Я написал что-то, что работало около 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