我在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