~~~~大神，哥哥，姐姐，谢谢给帮忙一下。1、B列和A列对比，提取出A列中唯一数据。 ...

q2008l

大神：
1、B列和A列对比，提取出A列中唯一数据。
比如A列有1、2、3   B列有3 提出：1、2

2、提取的数据重新生成无公式（就是不带VBA的）表格
（发件导入模板）
有表头的、其中A1以下为提出的数据，C\D\E\F\G 也有对应的填充。如（发件导入模板）的结果所示。
（第二次如果生成新的数据，生成新的表格把之前生成的表格给覆盖了。）

A列B列的数据不确定几条，有很多，是随时自己会粘贴进去对比的。

可不可以做个按钮用VBA处理呢（速度快的），小弟在这里万分感谢！！！

约定的童话

不带格式的话还必须得VBA了：
Sub 比对()
    Dim i, n, m, arr, brr, crr(1 To 10000, 1 To 1)
    arr = Range("a1:a" & [a65536].End(3).Row)
    brr = Range("b1:b" & [b65536].End(3).Row)
    For i = 2 To UBound(arr)
        For n = 2 To UBound(brr)
            m = m + 1
            If arr(i, 1) = brr(n, 1) Then
                Exit For
            Else
                If m = UBound(brr) Then
                    k = k + 1
                    crr(k, 1) = arr(i, 1)
                    m = 0
                End If
            End If
        Next
    Next
    [d2].Resize(UBound(crr), 1) = crr
End Sub

q2008l

约定的童话 发表于 2019-10-11 14:35
不带格式的话还必须得VBA了：
Sub 比对()
    Dim i, n, m, arr, brr, crr(1 To 10000, 1 To 1)

测试了一下，你的这个结果跟我要的结果不一样呢。。

风中稻草人

Sub test()
    Dim d As Object, ar, br, cr, i As Integer, bRow As Long
    Dim aRow As Long, n As Long
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("sheet2")
        aRow = .Cells(Rows.Count, 1).End(xlUp).Row
        bRow = .Cells(Rows.Count, 2).End(xlUp).Row
        ar = .Range("A2:A" & aRow).Value
        br = .Range("B2:B" & bRow).Value
    End With
    For i = 1 To UBound(br)
        d(br(i, 1)) = ""
    Next
    ReDim cr(UBound(ar), 1 To 1)
    For i = 1 To UBound(ar)
        If Not d.exists(ar(i, 1)) Then
            cr(n, 1) = ar(i, 1)
            n = n + 1
        End If
    Next
    Sheets("sheet2").Cells(2, "F").Resize(n, 1) = cr '核对你想要结果是否这样，是的话输入到你想要的表格即可
End Sub

sheeboard

python pandas写的，参考

1. import pandas as pd
   
2. 
   
3. df1=pd.read_excel('计算表格收发唯一值.xlsx',sheet_name=0,dtype={'运单编号A':'str','运单编号B':'str'})
   
4. 
   
5. yunA=df1['运单编号A'].to_list()
   
6. yunB=df1['运单编号B'].to_list()
   
7. uniqueset=set(yunA)-set(yunB)
   
8. 
   
9. result=pd.DataFrame(uniqueset,columns=['运单编号']
   
10. result['下一站']='成都中转'
    
11. result['班次']='班车'
    
12. result['物品类型']='混合'
    
13. .
    
14. .
    
15. .
    
16. result.to_excel('result.xlsx',index=False)

复制代码

q2008l

sheeboard 发表于 2019-10-11 19:35
python pandas写的，参考

1. Sub a()
   
2. Dim d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Dim arr
   
5. arr = [a1].CurrentRegion
   
6. Dim i&
   
7. For i = 2 To UBound(arr)
   
8.     d(arr(i, 2)) = ""
   
9. Next
   
10. Dim brr, n&
    
11. ReDim brr(1 To UBound(arr), 1 To 8)
    
12. For i = 2 To UBound(arr)
    
13.     If Not d.Exists(arr(i, 1)) Then
    
14.         n = n + 1
    
15.         brr(n, 1) = arr(i, 1)
    
16.         brr(n, 3) = "成都中转"
    
17.         brr(n, 4) = "班车"
    
18.         brr(n, 5) = "混合"
    
19.         brr(n, 6) = "班车件"
    
20.         brr(n, 7) = 0
    
21.     End If
    
22. Next
    
23. Dim wb As Workbook
    
24. Set wb = Workbooks.Open(ThisWorkbook.Path & "\发件导入模板.xls")
    
25. [a1].CurrentRegion.Offset(1).ClearContents
    
26. Columns(1).NumberFormat = "@"            '文本格式
    
27. [a1].Offset(1).Resize(n, UBound(brr, 2)) = brr
    
28. Set d = Nothing
    
29. End Sub

复制代码

q2008l

q2008l 发表于 2019-10-12 12:12

这个是另一个大神写的，我用上了， 速度快效果不错。你的我也学习测试一下。

q2008l

q2008l 发表于 2019-10-12 12:12

不知道谁能帮忙解释一下下面的代码么~学习一下

1. Sub a()
   
2. Dim d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Dim arr
   
5. arr = [a1].CurrentRegion
   
6. Dim i&
   
7. For i = 2 To UBound(arr)
   
8.     d(arr(i, 2)) = ""
   
9. Next
   
10. Dim brr, n&
    
11. ReDim brr(1 To UBound(arr), 1 To 8)
    
12. For i = 2 To UBound(arr)
    
13.     If Not d.Exists(arr(i, 1)) Then
    
14.         n = n + 1
    
15.         brr(n, 1) = arr(i, 1)
    
16.         brr(n, 3) = "成都中转"
    
17.         brr(n, 4) = "班车"
    
18.         brr(n, 5) = "混合"
    
19.         brr(n, 6) = "班车件"
    
20.         brr(n, 7) = 0
    
21.     End If
    
22. Next
    
23. Dim wb As Workbook
    
24. Set wb = Workbooks.Open(ThisWorkbook.Path & "\发件导入模板.xls")
    
25. [a1].CurrentRegion.Offset(1).ClearContents
    
26. Columns(1).NumberFormat = "@"            '文本格式
    
27. [a1].Offset(1).Resize(n, UBound(brr, 2)) = brr
    
28. Set d = Nothing
    
29. End Sub

复制代码

dongjuwen

q2008l 发表于 2019-10-12 12:13
不知道谁能帮忙解释一下下面的代码么~学习一下

那么多高手回你贴，你连起码的谢谢都不说一声……