运行时错误'6'OverFlow（Excel VBA）

我有这个错误，我有成千上万的csv文件被加载，它每次只能加载大约一百个文件。任何人都可以告诉我错误在哪里？运行时错误'6'OverFlow（Excel VBA）

Option Explicit 

Function ImportData() 

    Dim wkbCrntWorkBook As Workbook 
    Dim wkbSourceBook As Workbook 
    Dim rngSourceRange1 As Range 
    Dim rngSourceRange2 As Range 
    Dim rngDestination1 As Range 
    Dim rngDestination2 As Range 
    Dim intColumnCount As Integer 

    Set wkbCrntWorkBook = ActiveWorkbook 

    Dim SelectedItemNumber As Integer 

    Dim YesOrNoAnswerToMessageBox As String 

    Dim Highest As Double 
    Highest = 0 

    Dim counter As Integer 
    Dim h1 As Integer 
    Dim h2 As Integer 

    h1 = 1 
    h2 = 7 

    Do 

    SelectedItemNumber = SelectedItemNumber + 1 

    With Application.FileDialog(msoFileDialogOpen) 
     .Filters.Clear 
     .Filters.Add "Command Separated Values", "*.csv", 1 
     '.Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2 
     '.Filters.Add "Excel 2002-03", "*.xls", 3 
     .AllowMultiSelect = True 
     .Show 

    For SelectedItemNumber = 1 To .SelectedItems.Count 

     If .SelectedItems.Count > 0 Then 
      Workbooks.Open .SelectedItems(SelectedItemNumber) 
      Set wkbSourceBook = ActiveWorkbook 
      Set rngSourceRange1 = ActiveCell.Offset(1, 0) 
      Set rngSourceRange2 = ActiveCell.Offset(1, 6) 

      For counter = 0 To 300 

      Columns("H:H").NumberFormat = "0.00" 

      'Highest = Application.WorksheetFunction.Max(Range("H1:H300")) 

       If Highest <= ActiveCell.Offset(h1, h2).Value Then 
        Highest = ActiveCell.Offset(h1, h2).Value 
       End If 

       h1 = h1 + 1 

      Next 

      wkbCrntWorkBook.Activate 

      Set rngDestination1 = ActiveCell.Offset(1, 0) 
      Set rngDestination2 = ActiveCell.Offset(1, 1) 

      ActiveCell.Offset(1, 2).Value = Highest 

      For intColumnCount = 1 To rngSourceRange1.Columns.Count 

       If intColumnCount = 1 Then 
        rngSourceRange1.Columns(intColumnCount).Copy rngDestination1 
       Else 
        rngSourceRange1.Columns(intColumnCount).Copy rngDestination1.End(xlDown).End(xlDown).End(xlUp).Offset(1) 
       End If 
      Next 

      For intColumnCount = 1 To rngSourceRange2.Columns.Count 

       If intColumnCount = 1 Then 
        rngSourceRange2.Columns(intColumnCount).Copy rngDestination2 
       Else 
        rngSourceRange2.Columns(intColumnCount).Copy rngDestination2.End(xlDown).End(xlDown).End(xlUp).Offset(1) 
       End If 
      Next 

      ActiveCell.Offset(1, 0).Select 

      wkbSourceBook.Close False 
     End If 

    Next SelectedItemNumber 

    End With 

    YesOrNoAnswerToMessageBox = MsgBox("Continue?", vbYesNo) 

    Loop While YesOrNoAnswerToMessageBox = vbYes 


    Set wkbCrntWorkBook = Nothing 
    Set wkbSourceBook = Nothing 
    Set rngSourceRange1 = Nothing 
    Set rngSourceRange2 = Nothing 
    Set rngDestination1 = Nothing 
    Set rngDestination2 = Nothing 
    YesOrNoAnswerToMessageBox = Empty 
    SelectedItemNumber = Empty 
    Highest = Empty 
    counter = Empty 
    h1 = Empty 
    h2 = Empty 
    intColumnCount = Empty 

End Function

来源

2012-11-20 user1828786

我认为你最好首先弄清楚自己溢出的位置，然后告诉我们它是哪条线。 –

如何检查溢出的起始位置？感谢 – user1828786

通过添加断点或'MsgBox' .... –

要从未答复的问题列表中删除了这个问题，我要回答这个问题在“社区维基”的风格，以避免采取信用为其他人的工作。

正如Tim Williams在评论中回答的，部分答案是使用Long变量而不是Integer变量，以确保在运行大量迭代时不会超出允许的变量值。

答案的其他部分，正如user1828786最后一条评论所阐明的，是扫描您的代码中的逻辑错误，以确保您的计数器变量正在为您创建的每个循环重置。

来源

2013-02-10 06:50:17 Lokerim

运行时错误'6'OverFlow（Excel VBA）

回答

相关问题