[已解决]表格合并

liutqj

将两个表格合并在一个表格的取值问题。

最佳答案

月排行榜 / 总排行榜

爱疯

2015-4-14 13:34

Sub Click()
    Dim d, A, B
    Dim i, j, k

    '1）创建
    Set d = CreateObject("scripting.dictionary")
    For k = 1 To 2
        A = Sheets(k).Range("a1").CurrentRegion
        For i = 2 To UBound(A)
            If d.exists(A(i, 2)) Then
                For j = 1 To UBound(A, 2)
                    If A(i, j) = "" Then A(i, j) = "的"
                    If Asc(d(A(i, 2))(A(1, j))) < Asc(A(i, j)) Then d(A(i, 2))(A(1, j)) = A(i, j)    '比较
                Next j
            Else
                Set d(A(i, 2)) = CreateObject("scripting.dictionary")    '字典嵌套
                For j = 1 To UBound(A, 2)
                    If A(i, j) = "" Then A(i, j) = "的"
                    d(A(i, 2))(A(1, j)) = A(i, j)
                Next j
            End If
        Next i
    Next k

    '2）查询
    ReDim A(1 To d.Count + 1, 1 To UBound(A, 2))
    For j = 1 To UBound(A, 2)
        A(1, j) = Sheets(1).Cells(1, j)
    Next j
    B = d.keys
    For i = 2 To UBound(A)
        For j = 1 To UBound(A, 2)
            A(i, j) = d(B(i - 2))(A(1, j))
            If A(i, j) = "的" Then A(i, j) = ""
        Next j
    Next i

    '3）输出
    Sheets(3).Range("a1").CurrentRegion = ""
    Sheets(3).Range("a1").Resize(UBound(A), UBound(A, 2)) = A
End Sub
样表3.rar (21.19 KB, 下载次数: 13)

2015-4-14 13:31 上传

点击文件名下载附件



说明：
1）因为表二没有张三，所以1楼列举的结果：张三的是错的。

2）在表二里，=C2<D2，结果是True；但在VBA里
Sub test2()
    MsgBox "合格" < "优秀"'返回False
End Sub
因为如果Asc函数的参数为空，将返回错误，所以就先把""换成"的"，后把"的"换回""
Sub test3()
    Dim x, y, z
    x = Asc("的")
    y = Asc("合格")
    z = Asc("优秀")
    MsgBox x < y
    MsgBox y < z
End Sub

跳转到最佳答案楼层

徐淑颖

这个有点复杂了，不太懂，如果需要的话也是可以的！

liutqj

就是两次考试，考试成绩分为优秀、合格、不合格。有的人参加了两次考试，有的人参加了一次考试，我们将两次考试成绩汇总，如果两次考试中有一次考试为优秀的话，就取优秀，依次类推。

徐淑颖

就是取两次成绩中好的一次，是把？

liutqj

是

徐淑颖

看你想要什么效果了，这个方法有很多！用电辅助列，用电函数应该就可以达到效果了

liutqj

爱疯

Sub Click()
    Dim d, A, B
    Dim i, j, k

    '1）创建
    Set d = CreateObject("scripting.dictionary")
    For k = 1 To 2
        A = Sheets(k).Range("a1").CurrentRegion
        For i = 2 To UBound(A)
            If d.exists(A(i, 2)) Then
                For j = 1 To UBound(A, 2)
                    If A(i, j) = "" Then A(i, j) = "的"
                    If Asc(d(A(i, 2))(A(1, j))) < Asc(A(i, j)) Then d(A(i, 2))(A(1, j)) = A(i, j)    '比较
                Next j
            Else
                Set d(A(i, 2)) = CreateObject("scripting.dictionary")    '字典嵌套
                For j = 1 To UBound(A, 2)
                    If A(i, j) = "" Then A(i, j) = "的"
                    d(A(i, 2))(A(1, j)) = A(i, j)
                Next j
            End If
        Next i
    Next k

    '2）查询
    ReDim A(1 To d.Count + 1, 1 To UBound(A, 2))
    For j = 1 To UBound(A, 2)
        A(1, j) = Sheets(1).Cells(1, j)
    Next j
    B = d.keys
    For i = 2 To UBound(A)
        For j = 1 To UBound(A, 2)
            A(i, j) = d(B(i - 2))(A(1, j))
            If A(i, j) = "的" Then A(i, j) = ""
        Next j
    Next i

    '3）输出
    Sheets(3).Range("a1").CurrentRegion = ""
    Sheets(3).Range("a1").Resize(UBound(A), UBound(A, 2)) = A
End Sub
样表3.rar (21.19 KB, 下载次数: 13)

2015-4-14 13:31 上传

点击文件名下载附件



说明：
1）因为表二没有张三，所以1楼列举的结果：张三的是错的。

2）在表二里，=C2<D2，结果是True；但在VBA里
Sub test2()
    MsgBox "合格" < "优秀"'返回False
End Sub
因为如果Asc函数的参数为空，将返回错误，所以就先把""换成"的"，后把"的"换回""
Sub test3()
    Dim x, y, z
    x = Asc("的")
    y = Asc("合格")
    z = Asc("优秀")
    MsgBox x < y
    MsgBox y < z
End Sub