大家好！导入数据源和保存数据源有问题，请帮忙，十分感谢！！！

weifengcz

大家好！导入数据源和保存数据源有问题，请帮忙，十分感谢！！！ 2024=5=5修改.rar (10.18 KB, 下载次数: 9)

2024-5-5 10:22 上传

点击文件名下载附件

lcluck2002

没看明白这是要做什么。

weifengcz

您好！导入数据源不会写vba代码，谢谢老师！

weifengcz

lcluck2002 发表于 2024-5-5 10:48
没看明白这是要做什么。

文件1和文件2全部导入数据源放在表格，谢谢老师

ooluckydog

baofa2

1. Sub test0()
   
2.   Cells.ClearContents
   
3.   Application.ScreenUpdating = False
   
4.   Dim path_ As String, file_ As String
   
5.   Dim results(1 To 2345, 0) As String, temp
   
6.   Dim i As Long, cnt As Long, strText As String
   
7.   path_ = ThisWorkbook.Path & "\"
   
8.   file_ = Dir(path_ & "*.txt")
   
9.   While Len(file_)
   
10.     strText = strText & ReadUTFFiles(path_ & file_) & vbCrLf
    
11.     file_ = Dir
    
12.   Wend
    
13.   temp = Split(strText, vbCrLf)
    
14.   For i = 0 To UBound(temp)
    
15.     If Len(temp(i)) Then
    
16.       cnt = cnt + 1
    
17.       results(cnt, 0) = temp(i)
    
18.     End If
    
19.   Next
    
20.   Range("A1").Resize(cnt) = results
    
21.   Application.ScreenUpdating = True
    
22.   Beep
    
23. End Sub
    
24. 
    
25. Function ReadUTFFiles(ByVal strFullName As String) As String
    
26.   With CreateObject("ADODB.Stream")
    
27.     .Type = 2
    
28.     .Mode = 3
    
29.     .Open
    
30.     .LoadFromFile strFullName
    
31.     .Charset = "UTF-8"
    
32.     .Position = 2
    
33.     ReadUTFFiles = .ReadText
    
34.     .Close
    
35.   End With
    
36. End Function
    

复制代码

gwjkkkkk

Option Explicit
Sub test()
    Dim strResult$(), ar, j&, r&, n As Byte, strFileName$, strPath$
   
    ReDim strResult(1 To 10 ^ 5, 0)
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.txt")
   
    Do Until strFileName = ""
        n = FreeFile
        Open strPath & strFileName For Input As #n
            ar = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
        Close #n
        For j = 0 To UBound(ar)
            r = r + 1
            strResult(r, 0) = ar(j)
        Next j
        strFileName = Dir
    Loop
   
    Columns("A").Clear
    [A1].Resize(r) = strResult
    Beep
End Sub

weifengcz

baofa2 发表于 2024-5-5 11:28

无法！

gwjkkkkk

参与一下。。。

weifengcz

gwjkkkkk 发表于 2024-5-5 11:34
参与一下。。。

还可以，我需要打开一个导入数据源，再打开一个导入数据源，请大神再修改一下，万分感谢！