Question

我在文本文件中有一系列数据，如102201906000-102201911999-23451，数千。我想创建一个新的文本文件，将范围创建为数字，如。

102201906000 23451
102201906001 23451
102201906002 23451

直到

102201911999 23451

将最后一位数字保持为固定。我制作了以下代码。

Private Sub CommandButton21_Click()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lCol As Long
    Dim rngEnd As String
    Dim rng1 As String
    Dim rng2 As String
    Dim x As Long
    Dim Num As Range
    For Each Num In Range("A1:A" & LastRow)
        lCol = ActiveSheet.UsedRange.Columns.Count
        rngEnd = Split(Num, "-")(2)
        rng1 = Split(Num, "-")(0) - 1
        rng2 = Split(Num, "-")(1)
        For x = 1 To rng2 - rng1
            Cells(x, lCol + 1) = rng1 + x & " " & rngEnd
        Next x
    Next Num
    Application.ScreenUpdating = True
End Sub

但由于我有大量数据，我无法正常使用它。

当我在不使用电子表格的情况下运行宏时，我是否可以获得一些创建文本文件的帮助。

等待专家建议。

Answer 1

我会尝试一次写下所有内容。如果它们是连续的，则不需要单独循环和检查它们。

Private Sub CommandButton21_Click()
    Application.ScreenUpdating = False
    Dim lr As Long, nmbr As Long, bgn As String, nd As String

    With Worksheets("Sheet1")   '<~~set this worksheet properly!
        lr = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
        nd = .Cells(1, 1).Value2
        bgn = left(nd, 7)
        nmbr = CLng(Mid(nd, 8, 5))
        nd = right(nd, 5)
        With .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(lr, 1)
            .Formula = "=""" & bgn & """&TEXT(ROW(" & Rows(nmbr).Address(0, 0) & "), ""00000_)"")&""" & nd & """"
            .Value = .Value2
        End With
    End With
    Application.ScreenUpdating = True
End Sub

这会根据ROW function生成序号。前缀和后缀仅在A1中的第一个值上剥离一次，之后用作字符串变量。

Answer 2

假设您有一个文本文件，并且想要创建另一个文本文件，其中102201906000-102201911999-23451之类的每一行被102201906000 23451之类的行替换，使用VBScript比直接VBA更自然。您可以绕过将数据拉入Excel的需要（但是 - 它被编写为Excel宏，因此您需要从Excel调用它。只需稍加修改，您就可以完全从循环中删除Excel并使用纯VBScript）。

要使用它，您必须在项目中包含Microsoft Scripting Runtime的引用（VBA编辑器中为Tools/References）。

Sub ExpandData(inName As String, outName As String)
    Dim FSO As New FileSystemObject
    Dim tsIn As TextStream
    Dim tsOut As TextStream
    Dim startNum, endNum, i, line 'variants

    On Error GoTo err_handler

    Set tsIn = FSO.OpenTextFile(inName, ForReading)
    Set tsOut = FSO.OpenTextFile(outName, ForWriting, True)

    Do While tsIn.AtEndOfStream = False
        line = Split(tsIn.ReadLine, "-")
        If UBound(line) = 2 Then
            startNum = CDec(line(0))
            endNum = CDec(line(1))
            For i = startNum To endNum
                tsOut.WriteLine i & " " & line(2)
            Next i
        End If
    Loop
    tsIn.Close
    tsOut.Close
    Exit Sub
err_handler:
    Debug.Print "I'm confused!"
End Sub

像这样使用（inName必须与outName不同）：

Sub test()
    ExpandData "C:\Programs\test.txt", "C:\Programs\testout.txt"
End Sub

格式化文本文件并导出文本文件

2 个答案: