如何可以实现批量导入数据？

stvent

For i = 2 To UBound(arr)
                    For j = 2 To 11
                        n = n + 1
                        brr(n, 1) = Split(MyName, "-")(0)
                        brr(n, 2) = Split(MyName, "-")(1)
                        brr(n, 3) = Split(MyName, "-")(2)
                        brr(n, 4) = Split(MyName, "-")(3)
                        brr(n, 5) = Split(Split(MyName, "-")(4), ".")(0)
                        brr(n, 6) = arr(i, 1)
                        brr(n, 7) = arr(1, j)
                        brr(n, 8) = arr(i, j)
这么真搞不清楚

stvent

约定的童话 发表于 2019-11-6 16:32
你不会代码没有改直接用吧？代码要根据你的实际文件格式内容修改才可以啊

像我这种需求，for 后面的该怎么处理，或者，你能解释一下你的代码吗？

mmx1122

我估计你也不考虑什么运行速度了吧，能实现就行了。我的代码很啰嗦，我也不会字典数组。试试看吧。
汇总数据.rar (205.8 KB, 下载次数: 31)

2019-11-6 20:31 上传

点击文件名下载附件

约定的童话

stvent 发表于 2019-11-6 16:39
像我这种需求，for 后面的该怎么处理，或者，你能解释一下你的代码吗？

解释起来那麻烦很多啊，你还是去看看基础知识吧

stvent

Jaofuan 发表于 2019-11-6 16:21

非常感谢你的，代码路路最后加个\才正常！~我摸索了很久！

stvent

mmx1122 发表于 2019-11-6 20:33
我估计你也不考虑什么运行速度了吧，能实现就行了。我的代码很啰嗦，我也不会字典数组。试试看吧。

谢谢你！~已经能满足需求！~

stvent

Jaofuan 发表于 2019-11-6 16:21

br(1 To 10000, 1 To 7)
ar = wb.Sheets(1).Range("a1:g" & row)
我看不明白，你是如何定义的，能解决一下吗？我想学习一下

Jaofuan

stvent 发表于 2019-11-7 08:44
br(1 To 10000, 1 To 7)
ar = wb.Sheets(1).Range("a1:g" & row)
我看不明白，你是如何定义的，能解决 ...

Sub jaofuan()
    Dim wb As Workbook, ar, br(1 To 10000, 1 To 7), mFull$, row$    '定义变量 wb 为 工作簿,ar,br(1到10000,1到7),mFull$,row$
    Dim mPath$: mPath = "C:\Users\Administrator\Desktop\2019-11-5\"  ' **** 路径，请自行更改
    Dim mName$: mName = Dir(mPath & "*.xlsx")    '定义变量 mName$:mName=<查找文件或目录>(mPath & "*.xlsx")
    Application.ScreenUpdating = False    '关闭屏幕刷新(可以提高运行速度)
    Do While mName <> ""    '执行循环操作 当条件 mName 不等于 空值
        mFull = mPath & mName    'mFull=mPath & mName
        Set wb = CreateObject(mFull)    '设定 wb=<创建工程>(mFull)
        row = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).row    '行标= wb的<工作表>(1 )的 A 列最后一行
        ar = wb.Sheets(1).Range("a1:g" & row)    'ar= wb的<工作表>(1 )的<单元格>区域("a1:g" & 最后一行)
        For i = 4 To UBound(ar)    '设定变量范围为i=4到<数组上限>(ar)
            p = p + 1    'p=p+1
            br(p, 1) = ar(2, 7)    'br(p,1)=ar(2,7)
            br(p, 2) = ar(2, 5)    'br(p,2)=ar(2,5)
            br(p, 3) = ar(i, 2)    'br(p,3)=ar(i,2)
            br(p, 5) = ar(i, 3)    'br(p,5)=ar(i,3)
            br(p, 6) = ar(i, 4)    'br(p,6)=ar(i,4)
            br(p, 7) = ar(i, 5)    'br(p,7)=ar(i,5)
        Next    '下一个
        wb.Close False    ' wb的关闭 False'不保存关闭
        mName = Dir    'mName=下一个文件
    Loop    '循环执行
    Set wb = Nothing    '设定 wb=空值
    [b2].Resize(10000, 7) = br    ' [b2]的<重调大小>(10000,7)=br
    Application.ScreenUpdating = True    '开启屏幕刷新
    MsgBox "操作已完成 ", 64, "提醒"
End Sub

stvent

Jaofuan 发表于 2019-11-7 09:05
Sub jaofuan()
    Dim wb As Workbook, ar, br(1 To 10000, 1 To 7), mFull$, row$    '定义变量 wb 为 ...

受教了！~

stvent

Jaofuan 发表于 2019-11-7 09:05
Sub jaofuan()
    Dim wb As Workbook, ar, br(1 To 10000, 1 To 7), mFull$, row$    '定义变量 wb 为 ...

另外，我想请教一下你，能否在数据汇入的时候，把所有英文字母强制转成大写？