2

このエラーが発生しています。数千の csv ファイルをロードする必要があります。一度にロードできるのは約 100 ファイルのみです。誰がエラーがどこにあるのか教えてもらえますか?

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

この質問を未回答の質問リストから削除するには、他の人の仕事の功績を認めないように、「コミュニティ ウィキ」スタイルで回答します。

Tim Williams がコメントで答えたように、答えの一部は、Long変数の代わりにInteger変数を使用して、多数の反復を実行するときに許容変数値を超えないようにすることです。

user1828786 からの最後のコメントで明らかになったように、回答の他の部分は、コードをスキャンして論理エラーを検出し、作成したループごとにカウンター変数がリセットされていることを確認することです。

于 2013-02-10T06:50:17.687 に答える