Я собираюсь дать вам два ответа по цене одного. :)
В своей основе базовая логика, которую необходимо выяснить, если подстрока существует в данной строке, является стандартной частью VBA в функции InStr . Используя это, вы можете разбить свою логику, чтобы проверить значение ячейки и (условно) удалить остаток строки в функцию, подобную этой:
Private Function DeleteTextAfter(ByVal contents As String, _
ByVal token As String) As String
'--- searches the given string contents and if it finds the given token
' it deletes the token and all following characters
DeleteTextAfter = contents
Dim pos1 As Long
pos1 = InStr(1, contents, token, vbTextCompare)
If pos1 > 0 Then
DeleteTextAfter = Left(contents, pos1 - 1)
End If
End Function
Обратите внимание, что при использовании функции, созданной выше, нам не нужно вообще использовать Range.Find.
Как только вы это сделаете, ваша логика верхнего уровня состоит из настройки диапазона для поиска. Во всем моем коде я явно создаю объекты, которые ссылаются на рабочую книгу и рабочий лист, чтобы я мог делать вещи прямо. В простом примере, подобном этому, это может показаться излишним, но привычка оказывается полезной, когда ваш код становится более активным. Поэтому я настроил диапазон следующим образом
Dim thisWB As Workbook
Dim userLoadWS As Worksheet
Set thisWB = ThisWorkbook
Set userLoadWS = thisWB.Sheets("User Load")
Dim searchRange As Range
Set searchRange = userLoadWS.Range("E1:E3000")
Теперь цикл проходит через каждую ячейку и получает (потенциально) обновленное значение.
Dim cell As Variant
For Each cell In searchRange
If Not cell.value = vbNullString Then
Debug.Print cell.Address & " = " & cell.value
cell.value = DeleteTextAfter(cell.value, "Ext")
cell.value = DeleteTextAfter(cell.value, "/")
End If
Next cell
Итак, все ваше решение выглядит так:
Option Explicit
Public Sub TestDirectlyFromRange()
Dim thisWB As Workbook
Dim userLoadWS As Worksheet
Set thisWB = ThisWorkbook
Set userLoadWS = thisWB.Sheets("User Load")
Dim searchRange As Range
Set searchRange = userLoadWS.Range("E1:E3000")
Dim cell As Variant
For Each cell In searchRange
If Not cell.value = vbNullString Then
Debug.Print cell.Address & " = " & cell.value
cell.value = DeleteTextAfter(cell.value, "Ext")
cell.value = DeleteTextAfter(cell.value, "/")
End If
Next cell
End Sub
Private Function DeleteTextAfter(ByVal contents As String, _
ByVal token As String) As String
'--- searches the given string contents and if it finds the given token
' it deletes the token and all following characters
DeleteTextAfter = contents
Dim pos1 As Long
pos1 = InStr(1, contents, token, vbTextCompare)
If pos1 > 0 Then
DeleteTextAfter = Left(contents, pos1 - 1)
End If
End Function
Но подождите, это еще не все !!
Вы перебираете более 3000 строк данных. Это может стать медленным, если все эти строки заполнены или если вы увеличите количество строк для поиска. Чтобы ускорить поиск, ответ заключается в том, чтобы сначала скопировать данные в диапазоне в массив на основе памяти , изменить любые данные, а затем скопировать результаты обратно. В этом примере используется тот же Function DeleteTextAfter, что и выше, и он работает намного быстрее. Используйте тот, который подходит вам лучше всего.
Public Sub TestRangeInArray()
Dim thisWB As Workbook
Dim userLoadWS As Worksheet
Set thisWB = ThisWorkbook
Set userLoadWS = thisWB.Sheets("User Load")
'--- create the range and copy into a memory array
Dim searchRange As Range
Dim searchData As Variant
Set searchRange = userLoadWS.Range("E1:E3000")
searchData = searchRange.value
Dim i As Long
For i = LBound(searchData, 1) To UBound(searchData, 1)
If Not searchData(i, 1) = vbNullString Then
searchData(i, 1) = DeleteTextAfter(searchData(i, 1), "Ext")
searchData(i, 1) = DeleteTextAfter(searchData(i, 1), "/")
End If
Next i
'--- now copy the modified array back to the worksheet range
searchRange.value = searchData
End Sub