MyTetra Share
Делитесь знаниями!
Замена символов(набора символов) с шагом
31.07.2019
22:38
Текстовые метки: VBA, string, Chr, символ
Раздел: !Закладки - VBA

'=====================================================================================================================

'// Замена символов(набора символов) с шагом

Private Sub test_ReplaceChrInTEXT_Step()

strOld = "UUUUUUUUUU"

strNew = ReplaceChrInTEXT_Step(strOld, "U", "B", 6)

End Sub


Function ReplaceChrInTEXT_Step(ByVal strMain As String, _

ByVal strOld As String, _

ByVal strNew As String, _

ByVal intStep As Integer) As String

Dim i As Integer, intCount As Integer

Dim intLen_strOld As Integer


ReplaceChrInTEXT_Step = strMain


If Len(strOld) > 0 Then

intLen_strOld = Len(strOld)

Else

Exit Function 'не менять строку

End If


If intStep = 1 Then

'замена всех значений

ReplaceChrInTEXT_Step = Replace(strMain, strOld, strNew, 1, -1, vbTextCompare)

Exit Function

Else

intCount = 0

'If Len(ref_string) <> 1 Then intCountTEXT = CVErr(xlErrValue): Exit Function

For i = 1 To Len(strMain)

ff = Mid(strMain, i, intLen_strOld)

If Mid(strMain, i, intLen_strOld) = strOld Then

intCount = intCount + 1

If intCount = intStep Then

' Stop

ReplaceChrInTEXT_Step = Left(ReplaceChrInTEXT_Step, i - 1) & strNew & Right(ReplaceChrInTEXT_Step, Len(ReplaceChrInTEXT_Step) - i) 'Mid(ReplaceChrInTEXT_Step, i, intLen_strOld)

' ReplaceChrInTEXT_Step = Replace(strMain, strOld, strNew, i, 1, vbTextCompare)

intCount = 0

End If

End If

Next

End If

intCountTEXT = intCount


End Function

'=====================================================================================================================

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования