并表的2个代码

ddz79101

老师！希望将2个表《1》和《2》按列名合并到《3》中，现在问题是，第1个代码问题是，显示下沉和不全；第2个代码却不显示。望老师帮忙看看，我检查将空行也重删了，担心有假空格。

ddz79101

有老师帮忙看看原因吗，就是按列名合并1和2表，垂直放在3表中，谢谢

cjc209

示意结果 是不是1表的第一列接2表的第一列这种? 要是这种就是纵向合并

ddz79101

cjc209 发表于 2024-1-13 16:40
示意结果 是不是1表的第一列接2表的第一列这种? 要是这种就是纵向合并

是的！老师！就是2表并1表，列头一致

ddz79101

ddz79101 发表于 2024-1-13 17:15
是的！老师！就是2表并1表，列头一致

模拟结果如图

shiruiqiang

====好评送花====

ddz79101

shiruiqiang 发表于 2024-1-13 18:01
====好评送花====

谢谢老师！运行正确！

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, br, i&, j&, r&, k&, dic As Object, iPosCol&
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
   
    With [A5].CurrentRegion
        .Offset(1).Clear
        ar = .Resize(10 ^ 4)
        For i = 1 To UBound(ar, 2): dic(ar(1, i)) = i: Next
        r = 1
    End With
   
    For i = 1 To 2
        br = Worksheets(i).[A4].CurrentRegion.Value
        For k = 2 To UBound(br)
            r = r + 1
            For j = 1 To UBound(br, 2)
                If dic.exists(br(1, j)) Then
                    iPosCol = dic(br(1, j))
                    ar(r, iPosCol) = br(k, j)
                End If
            Next j
        Next k
    Next i
   
    [A5].Resize(r, UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

jsjysqr

运行了都是空的，没看懂你要什么效果