EXCEL VBA:如何将长变量值保存到数组?

时间:2015-02-14 12:01:51

标签: arrays excel vba excel-vba

在处理我的宏时,我很挣扎。我有一个数组(定义为Variant),我在其中放置了要导入到工作表的文件的名称。我有一个计数器(定义为Long)放置在For循环中以遍历所有数组的位置。 在浏览每个文件时,我调用一个函数来计算文件中的行数,以确保我不会导入超过1 excel表中允许的行数。我有一个第二个数组(再次定义为Variant),我想在打开的文件中存储这个行数。这个公共变量被定义为Long,当我尝试将值赋给数组时,我得到一个错误13“Type mismatch”。

For FilNamCntr = LBound(FilNams) To UBound(FilNams)
        File_To_Be_Checked = FilNams(FilNamCntr)
        Call File_Lenght_Checker
        FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows '<< Here I get an error
Next FilNamCntr

您有什么建议我如何将Long变量中的数字分配给数组? 我只想要一个带有文件名的数组来打开文件,第二个数组的大小(行数nb)要在导入文件之前检查我在工作表中已经有多少行以及我是否可以将文件导入当前片材。

下面我附上一个完整的代码:

    Option Explicit
    Public Sub FileImport_Multiple()
    Dim qry             As QueryTable
    Dim FilNams         As Variant
    Dim FilNams_Rows    As Variant
    Dim FilNamCntr      As Long
    Dim strQryName      As String
    Dim LastRow         As Long
    Dim ContainerWB     As Workbook
    Dim msgString       As String
    Dim RowCounter01    As Long
    Dim RowCounter02    As Long
    Dim wB              As Workbook
        FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
                                                   Title:="Select text files to Import", _
                                                   MultiSelect:=True)

        '===========================
        'Defining a name of this sheet to variable and setting up a statusbar
        '===========================

        Tool_name = ActiveWorkbook.Name

        Range("A1").Select

        'Check to see if any files were selected
        If TypeName(FilNams) = "Boolean" Then
                MsgBox "No Files Selected. Exiting Program."
                Exit Sub
            Else
                'msgString = Join(FilNams, vbCr)
                'MsgBox "FilNams is: " & msgString
        End If

        For FilNamCntr = LBound(FilNams) To UBound(FilNams)
                File_To_Be_Checked = FilNams(FilNamCntr)
                Call File_Lenght_Checker
                FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows
        Next FilNamCntr

        For FilNamCntr = LBound(FilNams) To UBound(FilNams)
            FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
        Next FilNamCntr

        'msgString = Join(FilNams, vbCr)
        'MsgBox "FilNams is: " & msgString
        For FilNamCntr = LBound(FilNams) To UBound(FilNams)
            With ActiveSheet
                On Error GoTo ErrorCatch:
                RowCounter01 = .Cells(.Rows.Count, "D").End(xlUp).Row
                'Append to previous data, if applicable
                If .Range("D" & Rows.Count).End(xlUp).Row = 1 Then
                        LastRow = 1
                    Else
                        LastRow = .Range("D" & Rows.Count).End(xlUp).Row + 1
                End If
                If (RowCounter01 + FilNams_Rows(FilNamCntr)) >= 1048576 Then
                        MsgBox "Not enough space to import text files. Exiting.."
                        Exit Sub
                End If
                'MsgBox "LastRow value is:" & LastRow 'verification test
                Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr), _
                                        Destination:=.Range("D" & LastRow))
                With qry
                    .Name = "Filename"
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = 437
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = False
                    .TextFileTabDelimiter = False
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    .TextFileOtherDelimiter = "|"
                    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            End With
        Next FilNamCntr
    Exit Sub
    ErrorCatch:
    MsgBox "Unexpected Error. Type: " & Err.Description
    End Sub

1 个答案:

答案 0 :(得分:0)

OP解决方案。

我设法修改代码,以便宏现在正常工作。当定义为Long而不是Variant时,我忘了重新调整数组。这是更新的代码:

Option Explicit
Public Sub FileImport_Multiple()
Dim qry             As QueryTable
Dim FilNams         As Variant
Dim FilNams_Rows    As Long  '<< Changed here from Variant to Long
Dim FilNamCntr      As Long
Dim strQryName      As String
Dim LastRow         As Long
Dim ContainerWB     As Workbook
Dim msgString       As String
Dim RowCounter01    As Long
Dim RowCounter02    As Long
Dim wB              As Workbook
    FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
                                               Title:="Select text files to Import", _
                                               MultiSelect:=True)

    '===========================
    'Defining a name of this sheet to variable and setting up a statusbar
    '===========================

    Tool_name = ActiveWorkbook.Name

    Range("A1").Select

    'Check to see if any files were selected
    If TypeName(FilNams) = "Boolean" Then
            MsgBox "No Files Selected. Exiting Program."
            Exit Sub
        Else
            'msgString = Join(FilNams, vbCr)
            'MsgBox "FilNams is: " & msgString
    End If

    For FilNamCntr = LBound(FilNams) To UBound(FilNams)
            ReDim Preserve FilNams_Rows(FilNamCntr)  '<< Here I forgot to ReDim
            File_To_Be_Checked = FilNams(FilNamCntr)
            Call File_Lenght_Checker
            FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows
    Next FilNamCntr

    For FilNamCntr = LBound(FilNams) To UBound(FilNams)
        FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
    Next FilNamCntr

    'msgString = Join(FilNams, vbCr)
    'MsgBox "FilNams is: " & msgString
    For FilNamCntr = LBound(FilNams) To UBound(FilNams)
        With ActiveSheet
            On Error GoTo ErrorCatch:
            RowCounter01 = .Cells(.Rows.Count, "D").End(xlUp).Row
            'Append to previous data, if applicable
            If .Range("D" & Rows.Count).End(xlUp).Row = 1 Then
                    LastRow = 1
                Else
                    LastRow = .Range("D" & Rows.Count).End(xlUp).Row + 1
            End If
            If (RowCounter01 + FilNams_Rows(FilNamCntr)) >= 1048576 Then
                    MsgBox "Not enough space to import text files. Exiting.."
                    Exit Sub
            End If
            'MsgBox "LastRow value is:" & LastRow 'verification test
            Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr), _
                                    Destination:=.Range("D" & LastRow))
            With qry
                .Name = "Filename"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 437
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        End With
    Next FilNamCntr
Exit Sub
ErrorCatch:
MsgBox "Unexpected Error. Type: " & Err.Description
End Sub