求求大侠：我需要用对话框的方式导入多条件多列数据并分列

诺言逝远去

我需要在“数据导入”里面用对话框的方式选择“原始数据”，并根据两个条件对数据进行分列整理，黄色为数据分列条件，绿色是需要导入的数据。原始数据里面的数据是固定位置。

ykcbf1100

都是英文名，头疼。

fzxba

1. Sub test1()
   
2.   Dim f As String
   
3.   With Application.FileDialog(msoFileDialogOpen) '1
   
4.     .InitialFileName = ThisWorkbook.Path
   
5.     With .Filters
   
6.       .Clear
   
7.       .Add "Excel Files", "*.xls?"
   
8.     End With
   
9.     .AllowMultiSelect = False
   
10.     If .Show Then f = .SelectedItems(1) Else Exit Sub
    
11.   End With
    
12.   
    
13.   Dim Conn As Object, SQL As String
    
14.   Dim ar, br(1 To 2) As String, i As Integer
    
15.   
    
16.   Worksheets(1).Activate
    
17.   ar = Range("A4", Range("A4").End(xlToRight))
    
18.   ar = WorksheetFunction.Transpose(WorksheetFunction.Transpose(ar))
    
19.   
    
20.   For i = 1 To UBound(ar)
    
21.     ar(i) = Replace(Replace(Replace(ar(i), "[", "("), "]", ")"), ".", "#")
    
22.     If i > 2 Then
    
23.       ar(i) = "b.[" & ar(i) & "]"
    
24.     Else
    
25.       br(i) = "[" & ar(i) & "]"
    
26.       ar(i) = "a.[" & ar(i) & "]"
    
27.     End If
    
28.   Next
    
29.   Set Conn = CreateObject("ADODB.Connection")
    
30.   Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    
31.    
    
32.   SQL = "SELECT " & Join(ar, ",") & " FROM " & _
    
33.         "[" & ActiveSheet.Name & "$A4:B" & Cells(Rows.Count, 2).End(xlUp).Row & "] a " & _
    
34.         "LEFT JOIN " & _
    
35.         "[Excel 12.0;Database=" & f & "].[$A1:IV] b " & _
    
36.         "ON a." & br(1) & "=b." & br(1) & " AND  a." & br(2) & "=b." & br(2)
    
37.         
    
38.   Range("A5").CopyFromRecordset Conn.Execute(SQL)
    
39.   
    
40.   Conn.Close
    
41.   Set Conn = Nothing
    
42.   Beep
    
43. End Sub

复制代码

fzxba

数据导入.rar (185.68 KB, 下载次数: 7)

2022-12-2 17:23 上传

点击文件名下载附件

诺言逝远去

fzxba 发表于 2022-12-2 17:23

谢谢大佬，很好用