创建多个输出文件的循环仅在一个停止

时间:2017-03-03 16:16:31

标签: excel-vba loops vba excel

我在Excel中有一个vba模块,几年前已经工作但现在没有。我觉得有些事情发生了变化(或有人做了改变),但我不确定是什么。该模块用于比较B列中的数据(预先排序);对于匹配它的每一行或多行输出一个txt文件。第一个文件是创建单行还是多行,然后停止。它不会转到下一行或一组行并创建第二个文件(.etc)。

代码:

Sub OrderEC()

    Dim Header(1 To 50) As Variant
    Dim StartRow As Integer
    Dim EndRow As Integer
    Dim txt As String
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim Count() As Variant
    Dim x As Integer
    Dim i As Integer
    Dim Users As Integer

    For i = 1 To 50
        Header(i) = Cells(1, i)
    Next

    Set Rng1 = Range("B2:B10000")
    For Each cell In Rng1
        If cell.Value = "" Then GoTo First

        ReDim Preserve Count(0 To 1, 0 To x) As Variant

        For i = 0 To x - 1
            If cell.Value = Count(1, i) Then
                Count(0, i) = Count(0, i) + 1
                GoTo First
            End If
        Next i

        Count(1, x) = cell.Value
        Count(0, x) = 1

        x = x + 1

First:
    Next

    Users = UBound(Count, 2)
    EndRow = 1

    For s = 1 To Users
        StartRow = EndRow
        EndRow = StartRow + Count(0, s - 1)

        DataFile = "C:\ECorder\" & "BULK_" & Cells(StartRow + 1, 2).Value & "_" & Format(DateTime.Now, "DDMMYYHHMMSS") & ".bulk"

        Open DataFile For Output As #1
        For U = 1 To 30
            Print #1, Header(U) & "=" & Cells(StartRow + 1, U)
        Next U

        For v = 31 To 40
            txt = Header(v) & "="
            For i = 1 To Count(0, s - 1)
                If i = 1 Then
                    txt = txt & Cells(StartRow + i, v)
                Else
                    txt = txt & ", " & Cells(StartRow + i, v)
                End If
            Next i
            Print #1, txt
        Next v

        For w = 41 To 44
            Print #1, Header(w) & "=" & Cells(StartRow + 1, w)
        Next w
        Close #1
    Next s

End Sub

0 个答案:

没有答案