请问怎么用函数或者VBA合并两表数据

很多鸡蛋 · 发表于 2025-3-26 17:41

请问下各位老师，表1和表二有“流程编码”字段可关联，但是存在一对多的情况，怎么用公式或者函数快速合并两表数据呢？谢谢

lcluck2002 · 发表于 2025-3-26 18:01

直接在表二插入两列，用Vlookup/xlookup按流程编号由表一引入流程状态和流程金额，OK乎？

很多鸡蛋 · 发表于 2025-3-26 18:16

本帖最后由很多鸡蛋于 2025-3-26 18:20 编辑

lcluck2002 发表于 2025-3-26 18:01
直接在表二插入两列，用Vlookup/xlookup按流程编号由表一引入流程状态和流程金额，OK乎？

也可以，但是实际内容是表1的数据就是几十列，表2只有四五列，如果以表2作为主表用公式的话，计算量很大，所以想以表1作为对照，以及，表1中的数据，表2里可能会没有，也需要手动加入。比如示例中的23的编码

dambcer · 发表于 2025-3-26 19:55

PQ合并查询，

凌空一羽 · 发表于 2025-3-26 21:16

ykcbf1100 · 发表于 2025-3-26 21:20

本帖最后由 ykcbf1100 于 2025-3-26 21:35 编辑

一键合并

ykcbf1100 · 发表于 2025-3-26 21:21

Sub ykcbf() '//2025.3.26 排重汇总全表自动生成
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("Scripting.Dictionary")
ReDim brr(1 To 10000, 1 To 100)
On Error Resume Next
bt = [{"流程编号","流程状态","详情选择","流程金额","分摊金额（含税）"}]
m = m + 1
For j = 1 To UBound(bt)
d(bt(j)) = j
brr(1, j) = bt(j)
Next
arr = Sheets("表2").UsedRange
For i = 2 To UBound(arr)
If arr(i, 1) <> Empty Then
m = m + 1
d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3))
For j = 1 To UBound(arr, 2)
s = arr(1, j)
If d.exists(s) Then
brr(m, d(s)) = arr(i, j)
End If
Next
End If
Next
arr = Sheets("表1").UsedRange
For i = 2 To UBound(arr)
If arr(i, 1) <> Empty Then
s = arr(i, 1)
If Not d.exists(s) Then
m = m + 1
For j = 1 To UBound(arr, 2)
s1 = arr(1, j)
If d.exists(s1) Then
brr(m, d(s1)) = arr(i, j)
End If
Next
brr(m, 3) = d(s)(0)
brr(m, 5) = d(s)(1)
End If
End If
Next
With Sheets("合并数据")
.UsedRange.Clear
.Cells.Interior.ColorIndex = 0
.[a1].Resize(1, 5).Interior.Color = 49407
.[a2].Resize(m - 1, 1).Interior.Color = 5296274
With .[a1].Resize(m, 5)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
Set Rng = .[a2].Resize(m - 1, 5)
Rng.Sort Rng.Columns(1), 1, Orientation:=1
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

翁知江安 · 发表于 2025-3-26 21:42

Sub test()
Dim i, j, k, p, q As Integer
Dim ar, br, cr As Variant
Dim kk
Dim d1, d2 As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
ar = Sheets("表1").[a1].CurrentRegion
br = Sheets("表2").[a1].CurrentRegion
ReDim cr(1 To 100, 1 To 10)
For i = 1 To UBound(br)
  d1(br(i, 1)) = ""
  d2(br(i, 1)) = ""
Next
For j = 1 To UBound(ar)
  d1(ar(j, 1)) = ""
Next
For Each kk In d1.keys
If d2.exists(kk) Then
      For i = 1 To UBound(br)
         If br(i, 1) = kk Then
         k = k + 1
            For p = 1 To UBound(br, 2)
            cr(k, 2 * p - 1) = br(i, p)
            Next
            For j = 1 To UBound(ar)
                  If ar(j, 1) = kk Then
                     For q = 2 To UBound(ar, 2)
                     cr(k, 2 * q - 2) = ar(j, q)
                     Next
                  End If
            Next
         End If
      Next
   Else
For j = 1 To UBound(ar)
      If ar(j, 1) = kk Then
      k = k + 1
         For p = 1 To 2
         cr(k, p) = ar(j, p)
         Next
         cr(k, 4) = ar(j, 3): cr(k, 5) = ar(j, 3)
      End If
Next
End If
Next
Sheets("合并数据").[a1].Resize(k, 10).ClearContents
Sheets("合并数据").[a1].Resize(k, UBound(cr, 2)) = cr
MsgBox "ok"
End Sub

翁知江安 · 发表于 2025-3-26 21:43

供参考，欢迎批评指正

很多鸡蛋 · 发表于 2025-3-27 12:48

ykcbf1100 发表于 2025-3-26 21:21

你好非常感谢，还想请问一下，实际数据源有几十列，不止5列，有什么快捷方法吗？

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

[求助] 请问怎么用函数或者VBA合并两表数据