如何用数组等方式实现快速导入数据

weyawu

请教，每天要导入分析10万行左右文本数据，如何将数据源按“实现目标示例”用数组等方式实现快速导入？谢谢 Desktop.zip (111.83 KB, 下载次数: 12)

2024-8-27 21:19 上传

点击文件名下载附件

ykcbf1100

TXT文本数据导入

附件供参考。。。

ykcbf1100

文本数据导入

1. Sub ykcbf()    '//2024.8.28   数据导入
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     With Application.FileDialog(msoFileDialogFilePicker)
   
6.         .InitialFileName = ThisWorkbook.Path & ""
   
7.         .Title = "请选择对应Excel文件"
   
8.         .AllowMultiSelect = False
   
9.         .Filters.Clear
   
10.         .Filters.Add "TXT文件", "*.*"
    
11.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
12.     End With
    
13.     Set wb = Workbooks.Open(f, 0)
    
14.     arr = wb.Sheets(1).UsedRange
    
15.     wb.Close 0
    
16.     ReDim brr(1 To 100000, 1 To 100)
    
17.     For i = 1 To UBound(arr)
    
18.         If Val(arr(i, 1)) = 1 Then k = k + 1: d(k) = i
    
19.     Next
    
20.     For k = 1 To d.Count
    
21.         r1 = d(k)
    
22.         If k = d.Count Then r2 =UBound(arr)  Else r2 = d(k + 1) - 1
    
23.         bm = Replace(Split(arr(r1, 1), "：")(1), "）", "")    '//上级部门
    
24.         st = WorksheetFunction.Trim(Trim(arr(r1 + 3, 1)))
    
25.         b = Split(st)
    
26.         st1 = CStr(Split(b(0), ":")(1))     '//机构号
    
27.         st2 = CStr(Split(b(1), ":")(1))     '//机构名称
    
28.         st3 = CStr(Split(b(2), ":")(1))     '//日期
    
29.         For i = r1 + 4 To r2
    
30.             If Val(Trim(arr(i, 1))) Then
    
31.                 st = WorksheetFunction.Trim(Trim(arr(i, 1)))
    
32.                 b = Split(st)
    
33.                 m = m + 1
    
34.                 brr(m, 1) = bm
    
35.                 brr(m, 2) = st1
    
36.                 brr(m, 3) = st2
    
37.                 brr(m, 4) = st3
    
38.                 For j = 0 To UBound(b)
    
39.                     brr(m, j + 5) = b(j)
    
40.                 Next
    
41.             End If
    
42.         Next
    
43.     Next
    
44.     With Sheets("Sheet1")
    
45.         .UsedRange.Offset(2).ClearContents
    
46.         .Columns(2).NumberFormatLocal = "@"
    
47.         .[a3].Resize(m, 20) = brr
    
48.     End With
    
49.     Set d = Nothing
    
50.     Application.ScreenUpdating = True
    
51.     MsgBox "OK！"
    
52. End Sub
    
53. 
    

复制代码

一招秒杀

每天导入分析10万行数据，居然不会用数据库，不会SQL, 更加不会Web 开发，其实这些一次做好，以后就只需要在网页上点点鼠标，即时呈现，一劳永逸，彻底自由。

weyawu

一招秒杀 发表于 2024-8-28 19:41
每天导入分析10万行数据，居然不会用数据库，不会SQL, 更加不会Web 开发，其实这些一次做好，以后就只需要 ...

我会简单的SQL,,不用鄙视人。不会WEB的人不会数据库的人多的去了。 知道你一招秒杀的嘚瑟，so what？！

weyawu

ykcbf1100 发表于 2024-8-28 08:34
TXT文本数据导入

附件供参考。。。

感谢热心的ykcbf1100大侠，

ykcbf1100

weyawu 发表于 2024-8-28 21:51
感谢热心的ykcbf1100版主，

不是版主，别乱说。

一招秒杀

weyawu 发表于 2024-8-28 21:49
我会简单的SQL,,不用鄙视人。不会WEB的人不会数据库的人多的去了。 知道你一招秒杀的嘚瑟，so what？！

看重点，找同事帮助，或者请外部的人帮忙，让这种事情一次性办好，这个数据量用Web 可能更快更方便，以后天天就轻松了，技术是很次要的东西，多少亿万富翁根本不会任何计算机技术，祝你好运，把事情办好。

weyawu

一招秒杀 发表于 2024-8-29 11:05
看重点，找同事帮助，或者请外部的人帮忙，让这种事情一次性办好，这个数据量用Web 可能更快更方便，以后 ...

亲，本人所在单位只允许导出txt的东东，涉及到其他数据做了网页控制，至于是什么控制技术我不懂，不允许技术外包。如果方便我想看看用的技术写的东东解决这个问题，那怕只允许我使用一次！
科技有编程术的人很讲政治的，不会私自帮你开发提高效率摸鱼的程序。科技人员只会网络扫描公司内部有否非法程序。
同事不懂VBA编程，自己以前用过单元格的VBA运算，对于涉及这种涉及复杂表头处理的，不会。

weyawu

ykcbf1100 发表于 2024-8-29 06:55
不是版主，别乱说。

对不起，ykcbf1100大侠，已改称呼。
今早测试OK，结合其他简单代码，5分钟可搞定分析了，但最主要还是您提供的原始数据采集处理工具。
再次感谢！