代码修改

lgzxmlg

跨工作簿取数。如何根据标题取数。 求助.zip (425.27 KB, 下载次数: 7)

2023-11-14 11:08 上传

点击文件名下载附件

Learner2022

讲一下你的需求，我没看懂要干嘛

lgzxmlg

Learner2022 发表于 2023-11-14 11:28
讲一下你的需求，我没看懂要干嘛

源数据是从网上导出的，数据列数不固定，需要的数据列会发生变化。变化后需要的数据无法提取到。
我想能不能根据标题，从源数据表中依据列标题提取到需要的数据。

512008404

按字段名提取数据。

liulang0808

Sub 导入数据()
   
    Set d = CreateObject("scripting.dictionary")
    tms = Timer
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsx")
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Offset(1).ClearContents
    brr = [a1].Resize(9999, 46)
    For j = 1 To UBound(brr, 2)
        If Len(brr(1, j)) > 0 Then d(Trim(brr(1, j))) = j
    Next j
    m = 1
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
             n = n + 1
             Set wb = GetObject(p & f)
             With wb.Sheets(1)
                  r = .Cells(.Rows.Count, 1).End(3).row
                  arr = .Range("a1:au" & r)
             End With
             wb.Close False
             For i = 2 To UBound(arr)
                 m = m + 1
                 For j = 1 To UBound(arr, 2)
                     If d.exists(arr(1, j)) Then
                        c = d(arr(1, j))
                        brr(m, c) = arr(i, j)
                     End If
                 Next
            Next
        End If
        f = Dir
    Loop
    Set wb = Nothing
    With Sheet1
         If m > 0 Then
              .Range("d:d").NumberFormatLocal = "@"
              .[a1].Resize(m, UBound(brr, 2)) = brr
         End If
    End With
    Application.ScreenUpdating = True
    MsgBox "汇总了：" & n & "个工作表；共有：" & m & "行数据 " & "用时：" & Format(Timer - tms, "0.00") & "秒"
End Sub

liulang0808

求助 (29).zip (419.06 KB, 下载次数: 14)

2023-11-14 13:19 上传

点击文件名下载附件

标题一致就可以汇总的，供参考。。。。。

沈默00

用find 或“match抓取下标题列的列号

lgzxmlg

liulang0808 发表于 2023-11-14 13:20
标题一致就可以汇总的，供参考。。。。。

谢谢帮忙。达到效果

lgzxmlg

liulang0808 发表于 2023-11-14 13:20
标题一致就可以汇总的，供参考。。。。。

求助 (29).zip (419.06 KB, 下载次数: 1)

2024-3-3 11:53 上传

点击文件名下载附件

gwjkkkkk

lgzxmlg 发表于 2024-3-3 11:54

主表F列改为故障描述，J列去除，可以写一下。。。