excel - 将写空格但不写最后一个字符(VBA Excel)

Question

数据:



期望的输出:



当前输出:



我当前的代码:

Private Sub GenerateFlatFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, j As Integer, SpacingCode As String

Dim iPar As Integer
Dim sBlank As Long
Dim cont As Boolean
Dim mystring As String

myFile = "C:\Reformatted.txt"
Set rng = Selection

Open myFile For Output As #1

Dim strArr(1 To 63) As String, intBeg As Integer, intEnd As Integer, intCount As Integer, sChar As String

For I = 2 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        If InStr(1, CStr(Cells(1, j).Value), "63") = 1 Then
            strArr(Val(Cells(1, j).Value)) = Cells(I, j).Value
        ElseIf InStr(1, CStr(Cells(1, j).Value), "Code") Then

                iPar = InStr(1, CStr(Cells(I, j).Value), "(")
                If Mid(Cells(I, j).Value, iPar - 1, 1) = "" Then
                    If Mid(Cells(I, j).Value, iPar - 2, 1) = "" Then
                    sChar = Mid(Cells(I, j).Value, iPar - 3, 1)
                    Else: sChar = Mid(Cells(I, j).Value, iPar - 4, 1)
                    End If
                Else: sChar = Mid(Cells(I, j).Value, iPar - 2, 1)
                End If
                If IsNumeric(Mid(Cells(I, j).Value, iPar + 1, 2)) Then
                    sBlank = Mid(Cells(I, j).Value, iPar + 1, 2)
                Else: sBlank = Mid(Cells(I, j).Value, iPar + 1, 1)
                End If
                mystring = Space(sBlank) & sChar
                cont = InStr(iPar + 1, CStr(Cells(I, j).Value), "(")

            Do While cont = True

                iPar = InStr(iPar + 1, CStr(Cells(I, j).Value), "(")
                If Mid(Cells(I, j).Value, iPar - 1, 1) = "" Then
                    If Mid(Cells(I, j).Value, iPar - 2, 1) = "" Then
                    sChar = Mid(Cells(I, j).Value, iPar - 3, 1)
                    Else: sChar = Mid(Cells(I, j).Value, iPar - 2, 1)
                    End If
                Else: sChar = Mid(Cells(I, j).Value, iPar - 1, 1)
                End If
                If IsNumeric(Mid(Cells(I, j).Value, iPar + 1, 2)) Then
                    sBlank = Mid(Cells(I, j).Value, iPar + 1, 2)
                Else: sBlank = Mid(Cells(I, j).Value, iPar + 1, 1)
                End If

                If sBlank + 1 > Len(mystring) Then
                    mystring = mystring & Space(sBlank - Len(mystring)) & sChar
                Else: mystring = Application.WorksheetFunction.Replace(mystring, sBlank + 1, 1, sChar)
                End If
                cont = InStr(iPar + 1, CStr(Cells(1, j).Value), "(")

            Loop

        ElseIf InStr(1, CStr(Cells(1, j).Value), "Difference") Then
            SpacingCode = Space(rng.Cells(I, j))
        Else
        intBeg = Val(Left(Cells(1, j).Value, InStr(1, Cells(1, j).Value, "-") - 1))
        intEnd = Val(Right(Cells(1, j).Value, Len(Cells(1, j).Value) - InStr(1, Cells(1, j).Value, "-")))
        intCount = 1
        For t = intBeg To intEnd
            strArr(t) = Mid(Cells(I, j).Value, intCount, 1)
            intCount = intCount + 1
        Next t
        End If
    Next j
    For t = 1 To UBound(strArr)
        If strArr(t) = "" Then strArr(t) = " "
        cellValue = cellValue + strArr(t)
    Next t
    Erase strArr
    cellValue = cellValue + SpacingCode
    cellValue = cellValue + mystring
    Print #1, cellValue
    cellValue = ""
Next I

Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub

我已经尝试了一段时间，但是当 ( 和字母之间有两个空格时，它似乎不起作用。

F 和 G 有效，因为只有 1 个空格。只有当有多个字母代码或两个空格时，它才不起作用。谢谢你的时间!

Answer 1

看来您的问题仅在于最后一列。这是一个 UDF，使用正则表达式

搜索字符串

查找任何“单词”(字母、数字和/或下划线的序列)，后跟零个或多个空格，然后是左括号标记 (

将这些单词序列组合成一个空格分隔的字符串

您应该能够将其合并到您的代码中。

如果您提供有关可能的代码类型的更多详细信息，则可能会更改正则表达式，但上述内容似乎很合适。

=================================================

Function Codes(S As String) As String
    Dim RE As Object, MC As Object, M As Object

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .Pattern = "\b(\w+)\s*\("
    If .test(S) = True Then
        Set MC = RE.Execute(S)
        For Each M In MC
            Codes = Codes & Space(1) & M.submatches(0)
        Next M
    End If
End With
Codes = Mid(Codes, 2)
End Function

=================================================