с помощью VBA, как, наконец, удалить дополнительные повторяющиеся символы

Question

У меня есть несколько строк, мне нужно объединить с символами "@ #" в конце каждого значения ячейки, я могу добавить эти символы, но в конце он печатает дополнительные символы (@ #)

Мой файл Excel: Из этого файла Excel мне нужно объединить значения по @ # для каждой ячейки и передать в блокнот

Файл Excel для ввода

Мой вывод долженbe: (фактический и ожидаемый)

фактический и ожидаемый результат

Вот мой код:

sub join()
dim LRow as long
dim LCol as long
Dim str1 as string
Dim str2 as string
Dim ws1 As Worksheet
Set ws1 = ActiveWorkbook.Worksheets(1)
 plik = ThisWorkbook.Path & "\" & "BL2ASIS" & ws1.Name & ".txt"
 Open plik For Output As 2
With ws1
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LCol = LCol - 2
slast = vbNullString


str2 = Join(Application.Transpose(Application.Transpose(.Cells(n, "A").Resize(1, 2).Value)), "")
str1 = str2 & Join(Application.Transpose(Application.Transpose(.Cells(n, "C").Resize(1, LCol).Value)), "@#") & "@#"
str1 = Replace(str1, "=", vbNullString)
str1 = Replace(str1, "@#@#", "@#")


Print #2, str1
End with

end sub

Answer 1

Вы можете заменить свою строку:

str1 = Replace(str1, "@#@#", "@#")

на:

Do Until Len(str1) = Len(Replace(str1, "@#@#", "@#"))
    str1 = Replace(str1, "@#@#", "@#")
Loop

, которая будет продолжать применять замену, пока в этом нет смысла (т.е. длина неизменить)

---

РЕДАКТИРОВАТЬ

Извините, что изменил принятый ответ, но я заметил, что вы можете сохранить экземпляры @ # @ #, если онипроисходят где-то , кроме конца строки.Если вы сделаете это, то будет лучше следующее, так как оно усекает только самые правые символы:

Do Until Right(str1, 4) <> "@#@#"
    str1 = Left(str1, Len(str1) - 2)
Loop

Answer 2

Причина, по которой вы получаете повторяющиеся символы, заключается в том, что вы соединяете пустые элементы массива.Альтернативой удалению повторяющихся разделителей является использование UDF только для объединения ненулевых значений.Пожалуйста, см. Ниже для такой функции.

Sub TestJoin()
    Dim r As Range: Set r = Worksheets("Sheet1").Range("B1:B12")
    Dim arr() As Variant
    arr = Application.Transpose(r)
    Debug.Print NonNullJoin(arr, "#") & "#"
End Sub

Function NonNullJoin(SourceArray() As Variant, Optional Delimiter As String = " ") As String
    On Error Resume Next
    Dim i As Long: For i = 0 To UBound(SourceArray)
        If CStr(SourceArray(i)) <> "" Then NonNullJoin = _
            IIf(NonNullJoin <> "", NonNullJoin & Delimiter & CStr(SourceArray(i)), CStr(SourceArray(i)))
    Next i
End Function

Answer 3

Используйте регулярное выражение для замены более одного экземпляра.

Примечание:

1. Если вы хотите заменить повторы только в конце строки, измените шаблон регулярного выражения на (@#){2,}$,Это будет иметь дело с 2 или более экземплярами.
2. Если вас беспокоит только два вхождения в конце, используйте (@#)\1$

Код:

Option Explicit

Sub TEST()
    Dim testString As String, pattern As String
    testString = "xxxxx@#@#"
    testString = RemoveChars(testString)
    Debug.Print testString
End Sub

Public Function RemoveChars(ByVal inputString As String) As String

    Dim regex As Object, tempString As String
    Set regex = CreateObject("VBScript.RegExp")

    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = "(@#){2,}"
    End With

    If regex.TEST(inputString) Then
        RemoveChars = regex.Replace(inputString, "@#")
    Else
        RemoveChars = inputString
    End If

End Function