Vba - 提取值并列出一次

问题描述 投票:0回答:1

我有一个电子表格,其中包含两个原始数据表,这些数据表位于从财务系统中提取的单独的Excel选项卡上,其中包含代表成本代码的值。两个选项卡上的数据集都非常大,我想要列出的代码只重复多次。我想要一个扫描这两个相关列的宏(比如两张纸上的A列),并在第三张纸上按数字顺序列出成本代码一次。

我搜索过这个网站,但似乎无法找到完全执行上述操作的代码。

提前致谢

list
1个回答
0
投票

这可能不是最快的实现,因为除了最终的排序之外,它主要依赖于VBA操作来完成工作。尚未经过测试。

Sub AppendUnique(ByVal W1 As Worksheet, ByVal W2 As Worksheet, ByVal R1 As Long, ByVal R2 As Long, ByVal C1 As Long, ByVal C2 As Long)
' Append values from an unsorted column to a new unique but unsorted column
    Dim V1 As Variant, V2 As Variant
    Dim I As Long
    V1 = W1.Cells(R1, C1).Value
    While Not IsEmpty(V1)
        I = R2
        V2 = W2.Cells(I, C2).Value
        While Not IsEmpty(V2)
            If V2 = V1 Then Exit While
            I = I + 1
            V2 = W2.Cells(I, C2).Value
        Wend
        W2.Cells(I, C2).Value = V1
        R1 = R1 + 1
        V1 = W1.Cells(R1, C1).Value
    Wend
End Sub

Dim W1 As Worksheet, W2 As Worksheet, W3 As Worksheet
Dim C1 As Long, Dim C2 As Long, Dim C3 As Long
Dim R1 As Long, Dim R2 As Long, Dim R3 As Long

Set W1 = Worksheets("Sheet1") ' Source 1
Set W2 = Worksheets("Sheet2") ' Source 2
Set W3 = Worksheets("Sheet3") ' Destination
C1 = 1 ' Column on Sheet1: Source 1
C2 = 1 ' Column on Sheet2: Source 2
C3 = 1 ' Column on Sheet3: Destination
R1 = 1 ' Starting Row on Sheet1: Source 1
R2 = 1 ' Starting Row on Sheet2: Source 2
R3 = 1 ' Starting Row on Sheet3: Destination

AppendUnique W1, W3, R1, R3, C1, C3
AppendUnique W2, W3, R2, R3, C2, C3
W3.Range(W3.Cells(R3, C3), W3.Cells(R3, C3).End(xlDown)).Sort
© www.soinside.com 2019 - 2024. All rights reserved.