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

诺言逝远去 · 发表于 2022-12-3 12:00

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

诺言逝远去 · 发表于 2022-12-3 12:21

后面黄色的数据为一组

smsn · 发表于 2022-12-3 13:16

使用vba+ado+sql 应该最合适

3190496160 · 发表于 2022-12-3 19:31

下载附件看了半天，还是不明所以，
1、黄色为数据分列条件，数据导入中的这两列没有任何数据的呀，
2、是不是根据工作表的名称来导入呢？？

诺言逝远去 · 发表于 2022-12-3 19:37

3190496160 发表于 2022-12-3 19:31
下载附件看了半天，还是不明所以，
1、黄色为数据分列条件，数据导入中的这两列没有任何数据的呀，
2、 ...

是的，需要根据原始数据里面的 n_t来分列

3190496160 · 发表于 2022-12-3 20:00

诺言逝远去发表于 2022-12-3 19:37
是的，需要根据原始数据里面的 n_t来分列

别人不是做你的工作的，所以，一定要对你的需求做具体的描述，必要时模拟一点结果便于别人理解，

fzxba · 发表于 2022-12-3 20:35

Sub test1()
Dim srcFile As String
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ThisWorkbook.Path
With .Filters
.Clear
.Add "Excel Files", "*.xls?"
End With
.AllowMultiSelect = False
If .Show Then srcFile = .SelectedItems(1) Else Exit Sub
End With
Dim Conn As Object, SQL As String
SQL = "SELECT F5,F45,F3,F44,F39,F98,F83,F241,F42,F236,F8,F128,F116,F119,F220,F197 FROM [$A2:IV]"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=no';Data Source=" & srcFile
With Range("A5")
.Resize(Rows.Count - .Row, Columns.Count).ClearContents
.CopyFromRecordset Conn.Execute(SQL)
End With
Conn.Close
Set Conn = Nothing
Beep
End Sub

复制代码

fzxba · 发表于 2022-12-3 20:48

数据导入.rar (165.59 KB, 下载次数: 6)

3190496160 · 发表于 2022-12-4 10:27

Sub 导入数据()
Application.ScreenUpdating = False
Dim ar As Variant, arr As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim fileOpenName
fileOpenName = Application.GetOpenFilename("Excel文件(*.xls*),*.xls")
If fileOpenName = False Then Exit Sub
Set wb = Workbooks.Open(fileOpenName)
With wb.Worksheets(1)
arr = .[a1].CurrentRegion
End With
wb.Close False
With ActiveSheet
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r >= 5 Then
      .Range("a5:p" & r).Borders.LineStyle = 0
      .Range("a5:p" & r) = Empty
End If
m = UBound(arr) + 3
y = .Cells(4, Columns.Count).End(xlToLeft).Column
.UsedRange.Offset(4).Clear
ar = .Range(.Cells(4, 1), .Cells(m, y))
For j = 1 To UBound(ar, 2)
      If Trim(ar(1, j)) <> "" Then
         d(Trim(ar(1, j))) = j
      End If
Next j
n = 1
For i = 2 To UBound(arr)
      If Trim(arr(i, 45)) <> "" Then
         n = n + 1
         For j = 1 To UBound(arr, 2)
            lh = d(Trim(arr(1, j)))
            If lh <> "" Then
                  ar(n, lh) = arr(i, j)
            End If
         Next j
      End If
Next i
.[a4].Resize(n, UBound(ar, 2)) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2022-12-4 10:28

数据导入.rar (170.88 KB, 下载次数: 4)

		自动登录	找回密码
密码			免费注册

[求助] 求求大侠：我需要用对话框的方式导入两个条件多列数据并根据条件进行分列