Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel vba使用字典循环提取数据_Excel_Vba - Fatal编程技术网

Excel vba使用字典循环提取数据

Excel vba使用字典循环提取数据,excel,vba,Excel,Vba,下面的代码可以循环文件夹中的文件并将文件名添加到字典中,但是当我添加提取代码时,它应该将文件夹中每个文件的数据提取到一个excel表中,文件1的范围应为A2:M2,文件2的范围应为A3:M3,依此类推。但是,尽管能够从每个文件中提取数据,但每次第一个文件都会写入A2:M2范围,但当它继续写入下一个文件时,它会将第一个文件中的数据覆盖到相同的A2:M2范围,即使文件2的数据应该写入A3:M3,文件3的数据应该写入A4:M4,以此类推 我可以知道如何解决这个问题吗,非常感谢 Public Dict

下面的代码可以循环文件夹中的文件并将文件名添加到字典中,但是当我添加提取代码时,它应该将文件夹中每个文件的数据提取到一个excel表中,文件1的范围应为A2:M2,文件2的范围应为A3:M3,依此类推。但是,尽管能够从每个文件中提取数据,但每次第一个文件都会写入A2:M2范围,但当它继续写入下一个文件时,它会将第一个文件中的数据覆盖到相同的A2:M2范围,即使文件2的数据应该写入A3:M3,文件3的数据应该写入A4:M4,以此类推

我可以知道如何解决这个问题吗,非常感谢

Public Dict As Object
Sub EEE()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False

Dim oFSO As Object, oFolder As Object, ofile As Object

Set oFSO = CreateObject("Scripting.fileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Users\Desktop\")

If Dict Is Nothing Then
Set Dict = CreateObject("Scripting.Dictionary")
    Dict.Add Key:="filename", Item:=ofile
End If

For Each ofile In oFolder.Files
    If Not Dict.Exists(oFSO.GetBaseName(ofile)) Then

' start of extraction code
            Dim a As Range

        Dim wkbData As Workbook
            Set wkbData = Workbooks.Open(ofile.path)

        Dim wksData As Worksheet
            ActiveSheet.Name = "Book1"
            Set wksData = wkbData.Worksheets("Book1") ' -> Assume this file has only 1 worksheet

            Dim LastRow As Long
                LastRow = wks.Range("A" & wks.Rows.count).End(xlUp).row + 1

            wks.Cells(LastRow, 6).value = ofile.Name

        Set a = wksData.Columns("A:A").Find("  test1234         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
        wks.Cells(LastRow, 1) = Split(a.value, ":")(1)
        End If

                wkbData.Close False
' end of extraction code 
                Range("A:M").EntireColumn.AutoFit
                Range("A1").AutoFilter

        Debug.Print "A: " & oFSO.GetBaseName(ofile)
        Dict.Add oFSO.GetBaseName(ofile), 1

    Else
        'skip
        Debug.Print "E: " & oFSO.GetBaseName(ofile)

    End If

Next ofile

        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.DisplayStatusBar = True

End Sub

以下是我的上述评论:

Dim LastRow As Long
LastRow = wks.Range("A" & wks.Rows.count).End(xlUp).row + 1 '<< this can be outside your loop

For Each ofile In oFolder.Files
    If Not Dict.Exists(oFSO.GetBaseName(ofile)) Then

        Dim a As Range

        Dim wkbData As Workbook
        Set wkbData = Workbooks.Open(ofile.path)

        Dim wksData As Worksheet
        Set wksData = wkbData.Worksheets(1) ' -> Assume this file has only 1 worksheet

        wks.Cells(LastRow, 6).value = ofile.Name

        Set a = wksData.Columns("A:A").Find("  test1234         : ", LookIn:=xlValues)
        If Not a Is Nothing Then
             wks.Cells(LastRow, 1) = Split(a.value, ":")(1)
        Else
             wks.Cells(LastRow, 1) = "No Data!"
        End If

        wkbData.Close False

        Debug.Print "A: " & oFSO.GetBaseName(ofile)
        Dict.Add oFSO.GetBaseName(ofile), 1

        LastRow = LastRow +1 '<< increment the row

    Else
        Debug.Print "E: " & oFSO.GetBaseName(ofile)
    End If

Next ofile
Dim LastRow尽可能长

LastRow=wks.Range(“A”&wks.Rows.count).End(xlUp).row+1”如果汇总表中的ColA未填充,则下次确定LastRow时,它将与上一次迭代结束在同一行。如果你想用可乐栏找到下一个空行,你应该在可乐里放些东西。非常感谢!虽然这不是解决我问题的答案,但它确实引导我度过难关并解决了我的问题,非常感谢你的帮助!