求代码

行走的

怎么把工作簿1和2的部分列的全部数据获取到工作簿3，然后实现动态更新啊，

蓝桥玄霜

2个工作簿应该有相同内容的列吧，附件等例子太马虎。

行走的

蓝桥玄霜 发表于 2022-12-28 18:53
2个工作簿应该有相同内容的列吧，附件等例子太马虎。

没有相同得列，我就想要指定的这些列

3190496160

行走的 发表于 2022-12-29 10:03
没有相同得列，我就想要指定的这些列

两个文件中肯定要有一列相同的吧？？不然，根据什么把两个文件的数据匹配到一行中来呢？？？

行走的

3190496160 发表于 2022-12-29 11:49
两个文件中肯定要有一列相同的吧？？不然，根据什么把两个文件的数据匹配到一行中来呢？？？

可以根据序号第一列把，就是要对应

于箱长

纯路过，进来看看

ykcbf1100

行走的 发表于 2022-12-29 13:15
可以根据序号第一列把，就是要对应

你这求助有点拉夸啊，别人问一下你才答一下，你不会求助时一次说清楚啊。
要把二个表的数据整合到一起去，必须要有相同的列去串联啊，这么重要的事都不说清楚，让别人一直猜来猜去的，玩儿呢。

3190496160

Sub 合并()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
With Sheets("质量表")
    ar = .Range("a1:s10000")
    For j = 1 To UBound(ar, 2)
        If Trim(ar(1, j)) <> "" Then
            d(Trim(ar(1, j))) = j
        End If
    Next j
    f = Dir(lj & "*.xls*")
    k = 1
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(lj & f)
            With wb.Worksheets(1)
                r = .Cells(Rows.Count, 1).End(xlUp).Row
                br = .Range("a1:x" & r)
            End With
            wb.Close False
            For i = 2 To UBound(br)
                If Trim(br(i, 1)) <> "" Then
                    t = d(br(i, 1))
                    If t = "" Then
                        k = k + 1
                        d(br(i, 1)) = k
                        t = k
                        ar(k, 1) = br(i, 1)
                    End If
                    For j = 1 To UBound(br, 2)
                        lh = d(Trim(br(1, j)))
                        If lh <> "" Then
                            ar(t, lh) = br(i, j)
                        End If
                    Next j
                End If
            Next i
        End If
    f = Dir
    Loop
    .[a1].Resize(k, UBound(ar, 2)) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

求解答.rar (109.52 KB, 下载次数: 4)

2023-1-1 14:21 上传

点击文件名下载附件

行走的

3190496160 发表于 2023-1-1 14:21

感谢坛友的解答，thanks