将写入空格而不是最后一个字符（VBA Excel）

数据：

期望的输出：

电stream输出：

我目前的代码：

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因为只有一个空间而工作。 只有当有多个字母代码或两个空格，它不起作用。 谢谢你的时间！

Answer 1

看来你的问题只是在最后一栏。 这是一个UDF，使用正则expression式

• search一个string
• 查找任何“单词”（字母，数字和/或下划线的序列），然后是零个或多个空格，然后打开一个圆括号标记(
• 将这些单词序列组合成空格分隔的string

你应该能够将其纳入你的代码。

如果你提供了更多关于可能代码types的细节，那么正则expression式可能会被修改，但是上面的代码似乎是合适的。

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

 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 

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