2

我遇到了这个错误，我要加载数千个 csv 文件，每次只能加载大约一百个文件。谁能告诉我错误在哪里？

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
4

1 回答 1

5

为了从未回答的问题列表中删除这个问题，我将以“社区 wiki”的方式回答这个问题，以避免将其他人的工作归功于他人。

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

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

于 2013-02-10T06:50:17.687 回答