|
代码更正- Sub 生成数据()
- Dim vData As Variant, sPath As String, sFileName As String
- Dim nID As Double, nFile As Integer
- Dim nNum As Integer, nI As Integer, nJ As Integer, nRow As Double
-
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Do
- sPath = InputBox("请输入需要分隔数据数量:")
- nNum = Val(sPath)
- If nNum = 0 Then _
- If MsgBox("输入有误或未输入,是否取消输入?", vbYesNo) = vbYes Then GoTo 退出生成数据
- Loop While nNum = 0
- vData = False
- Do
- vData = Application.GetOpenFilename(filefilter:="文件,*.*")
- If vData = False Then _
- If MsgBox("是否取消生成数据?", vbYesNo) = vbYes Then GoTo 退出生成数据
- Loop While vData = False
- sPath = vData
- vData = Split(sPath, "")
- sPath = Left(sPath, Len(sPath) - Len(vData(UBound(vData))))
- sFileName = ThisWorkbook.Name
- vData = Split(LCase(sFileName), ".xls")
- sFileName = vData(0)
- nID = 80000000
- vData = Sheet1.UsedRange.Value
- nFile = Int((UBound(vData) - 1) / nNum) + 1
- For nI = 0 To nFile - 1
- nID = nID + 1
- If Dir(sPath & nID & ".txt") <> "" Then Kill sPath & nID & ".txt"
- For nJ = 1 To nNum
- nRow = nI * nNum + nJ
- If nRow = 1 Then
- nJ = 1
- nRow = 2
- End If
- If nRow > UBound(vData) Or vData(nRow, 1) = "" Then Exit For
- If nJ = 1 Then
- Open sPath & nID & ".txt" For Output As #1
- Print #1, "ID,Index,ItemNumber,serial,Timestamp"
- End If
- Print #1, nID & "," & nJ & "," & sFileName & "," & vData(nRow, 1) & "," & vData(nRow, 2) & vData(nRow, 3)
- Next nJ
- Close #1
- Next nI
- MsgBox "完成!"
- 退出生成数据:
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|