请大师写一个两列数据去除数据并集的程序

hjqiang888

请大师写一个两列数据去除数据并集，并把得到的新数据写入txt格式的文件并打开的VBA程序,谢谢，详见附件。
工作簿3.rar (6.55 KB, 下载次数: 13)

2014-10-30 14:30 上传

点击文件名下载附件

liulang0808

表格内容看明白，都是关于需求中后半部分没有看明白
可以考虑使用下字典的

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    arr = [d4].CurrentRegion
    For j = 1 To 2
        For i = 1 To UBound(arr)
            If Len(arr(i, j)) > 0 Then
                If d.exists(arr(i, j)) Then
                    d.Remove arr(i, j)
                Else
                    d(arr(i, j)) = ""
                End If
            End If
        Next i
    Next j
    [g4].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
    Application.ScreenUpdating = True
End Sub

liulang0808

具体见附件内容
结果跟你的有出入，增加了第一列的数据

hjqiang888

liulang0808 发表于 2014-10-30 14:47
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dicti ...

您好  程序返回的结果不对  您看看示例中 ，我要的结果是  从数据B中 去掉数据A,把剩下的写入到单元格，如果可能，就把D.KEYS的内容，输出到文本文件中，谢谢

hjqiang888

liulang0808 发表于 2014-10-30 14:47
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dicti ...

程序虽然有点儿问题  仔细看了看  也能正常使用 谢谢

liulang0808

hjqiang888 发表于 2014-10-30 16:21
程序虽然有点儿问题  仔细看了看  也能正常使用 谢谢

可以简单调整下 ，把第二列数据读入字典，

bluexuemei

1. Sub test()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3. Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
4. y = ojs.eval("def aa(aa,bb);$aa=aa.flatten;$bb=bb.flatten;end")
   
5. y = ojs.Run("aa", Sheet1.Range("d4", [d4].End(4)).Value, Range("e4", [e4].End(4)).Value)
   
6. y = ojs.eval("Dir.chdir('" & ThisWorkbook.Path & "');f=File.new('1.txt','w');f.puts ($bb-$aa).map(&:to_i);f.close")
   
7. y = ojs.eval("($bb-$aa).zip")
   
8. [g4].Resize(UBound(y) + 1) = y
   
9. Set ojs = Nothing
   
10. 'Stop
    
11. End Sub

复制代码

hjqiang888

bluexuemei 发表于 2014-10-30 20:02

您好  程序写的非常好 有两个小问题，请问一下怎么处理呢？
1：源数据中 数据如果是文本型的数字，比如 出现002时  程序处理完后，变成了2，怎么让数据仍输出为002。
2：写入文本文件后，怎么调整一下格式，每行10个数，依次向下写入，谢谢！
很抱歉，今天的分用完了，明天补上。

bluexuemei

1. Sub test()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3. Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
4. y = ojs.eval("def aa(aa,bb);$aa=aa.flatten;$bb=bb.flatten;end")
   
5. y = ojs.Run("aa", Sheet1.Range("d4", [d4].End(4)).Value, Range("e4", [e4].End(4)).Value)
   
6. y = ojs.eval("Dir.chdir('" & ThisWorkbook.Path & "');f=File.new('1.txt','w');f.puts ($bb-$aa).map(&:to_i);f.close")
   
7. y = ojs.eval("($bb-$aa).each_slice(10).to_a")
   
8. [i4].Resize(UBound(y) + 1, UBound(y, 2) + 1).NumberFormat = "@"
   
9. [i4].Resize(UBound(y) + 1, UBound(y, 2) + 1) = y
   
10. Set ojs = Nothing
    
11. 'Stop
    
12. End Sub
    

复制代码