求助：利用VBA按指定条件导入计划数据，格式有点不一样。

一念成佛

如题，求助大神，帮个忙，这个我搞了半天，没搞懂，头大了。看起来简单，做起来一头雾水。关键本人只懂个皮毛。先谢谢了！！！


原表格有误，我刚更新了表格，A、B两张表，需要复制的单元格不一致，B表有合并单元格。请各位大神再帮帮手！

3190496160

Sub 查询()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("A表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "A表为空！": End
    ar = .Range(.Cells(1, 1), .Cells(r, 17))
End With
sr = InputBox("请输入月计划号进行查询", "月计划号", "8033")
If sr = "" Then End
With Sheets("B表")
    .UsedRange.Offset(1) = Empty
    br = .Range("a1:s" & r)
    For j = 1 To UBound(br, 2)
        If br(1, j) <> Empty Then
            d(br(1, j)) = j
        End If
    Next j
    n = 1
    For i = 2 To UBound(ar)
        If ar(i, 2) = Val(sr) Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                lh = d(ar(1, j))
                If lh <> "" Then
                    br(n, lh) = ar(i, j)
                End If
            Next j
        End If
    Next i
    If n = 1 Then MsgBox "没有符合条件的数据！": End
    .[a1].Resize(n, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

参考
计划导入.rar (15.71 KB, 下载次数: 15)

2024-4-11 10:44 上传

点击文件名下载附件

limonet

用高级筛选也可以

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, i%
    i = InputBox("请输入月计划号进行查询！！！")
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "Select 月计_划号,施工项目,施工日期,施工时间,线别,行别,施工地点,施工内容及影响范围,限速及行车方式变化,备注 From [A表$] Where 月计_划号=" & i
    Range("B2").CopyFromRecordset Cn.Execute(StrSQL)
    End Sub

yynrzwh

计划导入.zip (14.74 KB, 下载次数: 12)

2024-4-11 11:18 上传

点击文件名下载附件

ooluckydog

高级筛选函数，但是表头不能有合并单元格，字段顺序可以随意调整

清风竹-

请看附件。

一念成佛

3190496160 发表于 2024-4-11 10:43
Sub 查询()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant

你好，大神，能不能再麻烦您小小的改进一下，怎么样不导入A表的A2数据“1”、“4”，从b2开始复制，再一个日期“1-31”，导过来后变为“jun-31”，另外很欣赏你的细微观察力，需要导入到合并的单元格都被你注意到，且给解决了。

一念成佛

谢谢各位大神的友情帮助！