Удалить весь текст справа от позиции символа переменной на основе переменной длины строки

Проблема. У меня есть столбец, где каждая ячейка имеет разную длину и меняет структуру предложения. Если какая-либо ячейка превышает 1000 символов в длину, найдите первое вхождение либо [период], [запятая], [точка с запятой], [двоеточие] справа от 998-го символа в строке и замените этот символ на [3 периоды] (приложение, альтернативное многоточию). Наконец, обрезайте весь оставшийся текст после трех периодов.

Example-

Текущие данные: [[900 предыдущих символов]]. Visual Basic для приложений позволяет создавать пользовательские функции (UDF), автоматизировать процессы и получать доступ к API Windows и другим низкоуровневым функциям через библиотеки динамической компоновки (DLL).

Ожидаемый результат: [[900 предыдущих символов]]. Visual Basic для приложений позволяет создавать пользовательские функции (UDF)...

В "Current Data" длина = 1098 символов. 998-й символ является вторым в "proces S ". Первое появление одной из нужных знаков препинания справа - [запятая] после (UDF). Это заменяется на [3 периода], а остальная часть строки удаляется.

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

For i = 2 To LR


If Len(Cells(i, 2).Value) > 1000 Then

 Cells(i, 2).Value = Left(Cells(i, 2), 998)
 Cells(i, 2).Value = StrReverse(Replace(StrReverse(Cells(i, 2).Value), StrReverse("."), StrReverse("..."), Count:=1))


End If
Next i

Надеюсь, я предоставил много информации о том, что я пытаюсь.

3 ответа

Позиция последней допустимой пунктуации в пределах самых левых 1000 символов может быть расположена с помощью InStrRev.

dim str as string, p as long
for i=2 to lr
 str = cells(i, "B").value2
 if len(str) > 1000 then
 p = application.max(instrrev(str, chr(44), 998), _
 instrrev(str, chr(46), 998), _
 instrrev(str, chr(58), 998), _
 instrrev(str, chr(59), 998))
 cells(i, "B") = left(str, p-1) & string(3, chr(46))
 end if
next i


Попробуйте это, чтобы проверить первое появление любой пунктуации .,; : .,; : .,; : после 998 символов.

Dim teststring As String, firstcut As String, extension As String

teststring = String$(1000, "a") & _
 "Lorem ipsum dolor sit amet, consectetur adipiscing elit. " & _
 "In malesuada non enim nec posuere. Praesent placerat nulla enim, " & _
 "at porta justo pharetra ac."

If Len(teststring) > 999 Then
 firstcut = Left$(teststring, 998)

 extension = Right(teststring, Len(teststring) - 998)
 extension = Replace(Replace(Replace(extension, ",", "."), ";", "."), ":", ".")
 extension = Left$(extension, InStr(1, extension, ".") - 1) & "..."

 Debug.Print extension
End If


Попробуйте эту демонстрацию (может вам помочь)

Sub Demo()
Dim s As String
Dim p As Integer

s = "ab:cde,fghij Hello world, thanks a lot , for everything and "

p = InStr(10, s, ",")
Debug.Print p

s = Mid(s, 1, p - 1) & "..."
Debug.Print s
End Sub

Еще одна демонстрация, если вы будете иметь дело с большим количеством опций (запятая/период/точка с запятой)

Sub Demo2()
Dim a As Variant
Dim s As String
Dim p As Integer
Dim p1 As Integer
Dim p2 As Integer
Dim p3 As Integer

s = "ab:cde,fghij Hello ; world, thanks. a lot , for everything and "

p1 = InStr(10, s, ",")
p2 = InStr(10, s, ";")
p3 = InStr(10, s, ".")

a = Array(p1, p2, p3)
p = Evaluate("MIN(IF({" & Join(a, ";") & "}>0,{" & Join(a, ";") & "}))")
Debug.Print p

s = Mid(s, 1, p - 1) & "..."
Debug.Print s
End Sub

licensed under cc by-sa 3.0 with attribution.