循环保持重置

时间:2014-07-03 14:06:25

标签: excel vba excel-vba infinite-loop

我有以下代码

Sub Split_data()

' Split_data

Dim iCtr As Long
Dim Total As Long
Dim Iterations As Long
Dim FilePath As String

' Save path for new files
FilePath = "C:\DataFiles"

' Create folder to store files
If FileFolderExists(FilePath) Then
    ' Delete first row with obsolete data
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
Else
    MkDir (FilePath)
    ' Delete first row with obsolete data
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
End If

Total = Range("A1", Range("A1").End(xlDown)).Count
Iterations = Application.WorksheetFunction.RoundUp(Total / 2, 0)

' Generate the files
For iCtr = 1 To Iterations
    Generate_Files iCtr, FilePath
Next iCtr

End Sub

代码本身正常工作,除了1件事,当我完成For循环时,我的计数器神秘地重置为1并且它保持循环。

所以,如果我有5行,它会循环3次,iCtr值正常运行,但是一旦第3次循环完成,它会突然跳回到1并从头开始

所以任何人都看到了zhy,因为我已经尝试过几次一步一步地完成它,但我无法找到它跳回到1

其他代码如果重要:

Function Generate_Files(iCtr As Long, FilePath As String)
'
' Generates files which contain copied data of first copied x rows after which these rows are deleted
'

' Create variables
Dim wb1 As Excel.Workbook
Dim wb2 As Excel.Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Integer
Dim CurrPath As String

' Stop screen flickering
Application.ScreenUpdating = False

' Initialise variables
Set wb1 = ActiveWorkbook
Set ws1 = Worksheets(1)

    ' Create new workbook
Set wb2 = Workbooks.Add(1)

wb2.Activate
Sheets(1).Name = "data"
Set ws2 = Worksheets("data")

' Set path of created file
CurrPath = ThisWorkbook.FullName

' Copy data from wb1
wb1.Activate
ws1.Select
Rows("1:2").Select
Selection.Copy

' -!-
' Copy done afterwards to prevent issues with copied values disappearing from copy clipboard while creating new file
' -!-

' Activate wb2
wb2.Activate
ws2.Select

' Paste data in wb2
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Remove first x lines from original file
wb1.Activate
Rows("1:2").Select
Selection.Delete Shift:=xlUp

' Save & close wb2
wb2.Activate
ActiveWorkbook.SaveAs ("C:\DataFiles\Split Data" & iCtr)
ActiveWorkbook.Close

Application.ScreenUpdating = True

End Function



Public Function FileFolderExists(strFullPath As String) As Boolean

On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

EarlyExit:
On Error GoTo 0
End Function

2 个答案:

答案 0 :(得分:1)

尝试声明你的函数:

Function Generate_Files(ByVal iCtr As Long, ByVal FilePath As String)
' the rest of the function definition

默认情况下,VBA FunctionSub的参数为ByRef,这意味着被调用的函数/子例程可以修改调用函数/子例程中的参数。 ByVal会阻止这种情况发生。

稍后修改

另一种方法是强制编译器将调用传递给ByVal的参数转换为调用函数:

For iCtr = 1 To Iterations
    Generate_Files (iCtr), FilePath
Next iCtr

解释here

答案 1 :(得分:0)

尝试确认循环之前或之后的代码没有再次执行。可能会再次调用整个Split_data函数,或某种函数递归导致此函数的多个实例一次执行。尝试在循环之前和之后输出一些调试文本,并确保它只进入一次。