Question

我正在尝试使用一个非常简单的VBA宏来实现一种解析许多固定宽度格式（数百种）的方法。

生成这些格式的软件为我提供了一个非常简洁的描述，我已经解析过如下：

FD1 FD2 FD3 FD4
--  --  --  --
2   3   3   5
AACCC  FUUUUU
AAHHH  FGGGGG
55HHH  FVVVVV
55HHH--LVVVVV
PPNNN  LVVVVV
PPJJJ--LDDDDD

显然，这是我创建的模拟数据，可以进行一些测试来重现问题。

请注意，我的数据可以或不可以由任何字符（包括空格）开头（或成功）。我写了以下内容（非常天真和未经审查）代码：

Sub LoopParser()
    Const SizesRow = 3
    Const DataStart = "A4"

    Dim ToCut
    ToCut = 0

    Range(DataStart).Select

    Do Until IsEmpty(ActiveCell)
        ToCut = ActiveSheet.Cells(SizesRow, ActiveCell.Column).Value

        Call ParseOneField(ActiveCell.Address, CInt(ToCut))
        ActiveCell.Offset(0, 1).Select
    Loop

    Range(DataStart).Select

End Sub

Sub ParseOneField(TargetCell, DesiredSize As Integer)
    Const MaxLayout = 10000#

    Range(TargetCell).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns _
        Destination:=Range(TargetCell), _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, xlTextFormat), _
                         Array(DesiredSize, xlTextFormat), _
                         Array(MaxLayout, xlTextFormat) _
                         ), _
        TrailingMinusNumbers:=True

End Sub

但它有一个问题：当我尝试解析第三列数据时，空白是松散的（除了我使用的是xlTextFormat（2））来处理它们，我总是得到这样的结果：

FD1 FD2 FD3 FD4
--  --  --  --
2   3   3   5
AA  CCC FUU UUU
AA  HHH FGG GGG
55  HHH FVV VVV
55  HHH --L VVVVV
PP  NNN LVV VVV
PP  JJJ --L DDDDD

当预期结果为（保留第三个字段中的空白）时

FD1 FD2 FD3 FD4
--  --  --  --
2   3   3   5
AA  CCC   F UUUUU
AA  HHH   F GGGGG
55  HHH   F VVVVV
55  HHH --L VVVVV
PP  NNN   L VVVVV
PP  JJJ --L DDDDD

关于如何解决这个问题的任何想法？即使是解决方法就足够了。

我正在考虑设计测试以获取给定数据集中的任何未使用的字符，并在任何更改之前用空格替换空白，然后将字符更改回空白，但这感觉就像作弊。： - （

更新

我将xlsm文件发布到@sgdva某处感到不舒服，而是让我就如何重现我的确切问题给出一些指示。

首先前往this gist on github，在那里你会找到我的代码和数据的一些摘录，格式正确。

然后将输入数据复制/传递到新的电子表格中，我希望excel能够识别第一个树行中的选项卡，并能够将名称/大小分成列，同时将接下来的6行保持为简单文本

然后将代码复制/粘贴到全新的Excel模块中，并针对数据运行。

如果您还有任何问题，请在评论中告诉我。

Answer 1

终于找到了解决方案!!

比以前的代码更加天真和肮脏，但是想在此发布以供将来参考。

Sub LoopParser()
    Const SizesRow = 3
    Const DataStart = "A4"
    Const SizesStart = "A3"

    Dim CutPoint
    Dim EachSize(1) As Integer
    Dim CutPointsArray() As Variant
    Dim CurrentArrayPos As Integer

    CutPoint = 0
    CurrentArrayPos = 0

    Range(SizesStart).Select

    EachSize(0) = CInt(CutPoint)
    EachSize(1) = xlTextFormat

    ReDim Preserve CutPointsArray(0 To CurrentArrayPos)
    CutPointsArray(CurrentArrayPos) = EachSize

    Do
        CurrentArrayPos = CurrentArrayPos + 1
        CutPoint = CutPoint + ActiveSheet.Cells(SizesRow, ActiveCell.Column).Value
        EachSize(0) = CInt(CutPoint)
        EachSize(1) = xlTextFormat

        ReDim Preserve CutPointsArray(0 To CurrentArrayPos)
        CutPointsArray(CurrentArrayPos) = EachSize
        'Call ParseOneField(ActiveCell.Address, CInt(CutPoint))
        ActiveCell.Offset(0, 1).Select
    Loop Until IsEmpty(ActiveCell)

    Range(DataStart).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns _
        Destination:=Range(DataStart), _
        DataType:=xlFixedWidth, _
        FieldInfo:=CutPointsArray, _
        TrailingMinusNumbers:=True

    Range(DataStart).Select

End Sub

更大的变化是：

尺码必须与每个CutPoint相加，因此我们不是一系列尺码，而是CutPointsArray
我不是一次解析每一列，而是解析大小并在一个循环中构造CutPointsArray，然后用它来一步解析数据

TextToColumns中的问题xlFixedWidth松散空白

1 个答案: