Excel VBA宏跳出循环,没有得到原因

时间:2014-05-31 05:52:59

标签: excel vba excel-vba

有人可以确认为什么我的宏跳出循环。我不明白为什么会这样。

我的输入看起来像http://i.imgur.com/Y6XRBai.jpg enter image description here

我正在尝试拆分文本并使用while循环从D2列开始写入文本文件,第一个文件正确写入,但是当它开始写入第二个文件时是循环还是条件爆发并且宏到达strDir启动的行

Sub SplitTextAndSave()
'Macro to split text and write to text file
'Full name of File name will be Single quote + Prefix from B2 + ( + filename from C2 + )'
'Application.DisplayAlerts = False
Dim Val, splitVal As String
Dim reqNumTxt, totLn, reqNum, remChr, i As Integer
Dim wb As Workbook
Dim strFile, fileNm, strDir As String

Set Sheet = Excel.ActiveSheet
' Select where to place the files
Dim obj As Object
    Dim path As String
    Set obj = CreateObject("Shell.Application").browseforfolder(0, "Please Select Folder where TWS scripts will be created", 0)
On Error GoTo error_trap:
    path = obj.self.path & "\"
error_trap:

'this is where it starts again when the loop breaks
strDir = path
filepre = Sheet.Cells(2, 2).Value
reqNum = Sheet.Cells(3, 2).Value
reqNumTxt = 0

Sheet.Cells(2, 4).Activate
Do While ActiveCell.Value <> ""
    Set nextcell = ActiveCell.Offset(1, 0)

    fileNm = ActiveCell.Offset(0, -1).Value
    FileFullNm = strDir & "'" & filepre & "(" & fileNm & ")'"
    Open FileFullNm For Output As #1


    Val = ActiveCell.Value
    totLn = Int(Len(Val) / reqNum)
    remChr = Len(Val) Mod reqNum
    If Len(Val) <= reqNum Then
         Print #1, Val
         Close #1
    Else
        For i = 1 To totLn
            'I observed sometimes loop breaks here
            splitVal = Left(Right(Val, Len(Val) - reqNumTxt), reqNum)
            Print #1, splitVal
            reqNumTxt = reqNumTxt + reqNum
        Next i

            If remChr = 0 Then
                Close #1
            Else
                'most of the time loop break here when writing second file
                splitVal = Left(Right(Val, Len(Val) - reqNumTxt), reqNum)
                Print #1, splitVal
                Close #1
            End If
    End If
    nextcell.Select
        Set currentcell = nextcell

         'Next
Loop
MsgBox "Done"
'Application.DisplayAlerts = True
End Sub

1 个答案:

答案 0 :(得分:1)

我在代码中添加了两行,它运行时没有错误。我将splitVal设置为null,将reqNumTxt设置为零。

Val = ActiveCell.Value
totLn = Int(Len(Val) / reqNum)
remChr = Len(Val) Mod reqNum
**splitVal = ""**
If Len(Val) <= reqNum Then
     Print #1, Val
     Close #1
Else
    For i = 1 To totLn
        'I observed sometimes loop breaks here
        splitVal = Left(Right(Val, Len(Val) - reqNumTxt), reqNum)
        Print #1, splitVal
        reqNumTxt = reqNumTxt + reqNum
    Next i

        If remChr = 0 Then
            Close #1
        Else
            'most of the time loop break here when writing second file
            splitVal = Left(Right(Val, Len(Val) - reqNumTxt), reqNum)
            Print #1, splitVal
            Close #1
        End If
End If
nextcell.Select
    Set currentcell = nextcell

**reqNumTxt = 0**

循环