求老师帮写个VBA代码从多表中选择相同及不同数据

efttr55dyf

lzxdy 发表于 2017-10-18 11:24
表的规律只是横向数量变化，可在代码中设参数如z1,z1代表起、止块，只需要改z1，z2值那可参不同列处理：
...

lzxdy老师您好,收到您的再次指教,特来拜谢,谢谢特别提醒,打扰多次,再次感谢lzxdy老师一次次帮助.Excelhomem因为有许多您们这样乐于助人的老师而倍加精彩兴盛!

weiyingde

lzxdy 发表于 2017-10-15 22:11
试试：

lzxdy友，向你讨教。
我的代码，如下，显然有问题，但我才疏学浅，不能看出问题的所在，烦请指教。
希望能在我的代码上修改，这样，我要接受和消化。
代码如下：
Sub 对比2()
On Error Resume Next
Dim rg As Range, crr(1 To 10, 1 To 9)
For i = 1 To 6
    Set rg = Sheet1.Range("A4:H13").Offset(0, (i - 1) * 9)
    arr = rg.Value
    Set rng = Sheet1.Range("A15:H24").Offset(0, (i - 1) * 9)
    brr = rng.Value
    Set d = CreateObject("scripting.dictionary")
      For Each rn1 In arr
        If rn1 <> "" Then
           For Each rn2 In brr
             If rn2 <> "" Then
                 If rn1 = rn2 Then
                    n = n + 1
                    m = IIf(n < 8, 1, Int(n / 8))
                    p = IIf(n Mod 8 = 0, 8, n Mod 8)
                   crr(m, p) = rn2
                    Set rng1 = Nothing
                    Set rng2 = Nothing
                 Else
                    d(rn1) = ""
                    d(rn2) = ""
                 End If
             End If
            Next
         End If
         
      Next
    Sheet1.Cells(45, (i - 1) * 9 + 1).Resize(10, 9) = crr
    k = d.keys
    t = d.Count
         For j = 0 To t
           r = Int(j / 8)
           y = j Mod 8
           Sheet1.Cells(55, 1).Offset(r, (i - 1) * 9 + y) = k(j)
         Next
     n = 0
    Set d = Nothing
    Set k = Nothing
Next
End Sub

问题是：
1、重复的数字，遗漏了
2、字典里居然包含了重复烦人内容。
问题应该不是IF ……else……end if 吧？
可是有时什么惹得祸呢？
附件如下：

lzxdy

weiyingde 发表于 2017-10-19 19:38
lzxdy友，向你讨教。
我的代码，如下，显然有问题，但我才疏学浅，不能看出问题的所在，烦请指教。
希 ...

生成的字典中包含了前面两张表中的所有数字，只需要去除掉表甲1中的数字即可，因此可在
    k = d.keys的前一行加上：
    For Each rn3 In crr
      d.Remove rn3
    Next
即可。
也可改变循环方式，发现重复的就去除掉，可作如下修改：
      For Each rn1 In arr
        If rn1 <> "" Then
           For Each rn2 In brr
             If rn2 <> "" Then
                 If rn1 = rn2 Then
                    n = n + 1
                    m = IIf(n < 8, 1, Int(n / 8))
                    p = IIf(n Mod 8 = 0, 8, n Mod 8)
                    crr(m, p) = rn2
                    Set rng1 = Nothing
                    Set rng2 = Nothing
                    
                 Else
                    d(rn1) = ""
                    d(rn2) = ""
                 End If
             End If
            Next
         End If
      Next
改为：
      For j = 1 To 10       '改循环方式
      For k = 1 To 8
        If arr(j, k) <> "" Then
           For x = 1 To 10      '改循环方式
           For y = 1 To 8
             If brr(x, y) <> "" Then
                 If arr(j, k) = brr(x, y) Then
                    n = n + 1
                    m = IIf(n < 8, 1, Int(n / 8))
                    p = IIf(n Mod 8 = 0, 8, n Mod 8)
                    crr(m, p) = brr(x, y)
                    Set rng1 = Nothing
                    Set rng2 = Nothing
                    d.Remove brr(x, y)   '去重
                    brr(x, y) = ""      '去重
                    Exit For
                 Else
                    d(arr(j, k)) = ""
                    d(brr(x, y)) = ""
                 End If
             End If
            Next
            Next
         End If
      Next
      Next
以上只是一种思路，提供参考。

lzxdy

weiyingde 发表于 2017-10-19 19:38
lzxdy友，向你讨教。
我的代码，如下，显然有问题，但我才疏学浅，不能看出问题的所在，烦请指教。
希 ...

另外，上面中的d(rn2) = ""或d(brr(x, y)) = ""应该去掉，才符合原问题本义。

weiyingde

lzxdy 发表于 2017-10-19 21:58
生成的字典中包含了前面两张表中的所有数字，只需要去除掉表甲1中的数字即可，因此可在
    k = d.keys ...

谢谢你，我消化一下，有问题再请教你。

weiyingde

lzxdy 发表于 2017-10-19 21:58
生成的字典中包含了前面两张表中的所有数字，只需要去除掉表甲1中的数字即可，因此可在
    k = d.keys ...

测试了一下，结果是，列出的重复数还是少了……

efttr55dyf

weiyingde 发表于 2017-10-20 09:39
测试了一下，结果是，列出的重复数还是少了……

哈哈没想到weiyingde 友也对此感兴趣,我这里也要感谢你一下,你另写的代码及设置中有一点是让我  一直以来不知要怎么样做的,看了你的东东结果终于搞清了,哈也算是无心插柳之收获了,谢谢你. lzxdy老师 说生成的字典中包含了前面两张表中的所有数字，只需要去除掉表甲1中的数字即可，可是他可能没注意到你代码选择出来的表甲1中重复数据本来就没有选择完全,所以他修改的只需要去除掉表甲1中的数字  得到的结果肯定是不全的了!你最终结果肯定要包含得有重复数据

efttr55dyf

weiyingde 发表于 2017-10-20 09:39
测试了一下，结果是，列出的重复数还是少了……

weiyingde 友我希望你能继续跟进 并完成此代码,虽然你选择本意和我有所不同,我是只要表一余下不同,你是要常规下大家都要的表一和表1中所有不同,毕竟大多时候还是你那种选择需要多些,期判你成攻,需要时也好得以应用.

weiyingde

efttr55dyf 发表于 2017-10-20 11:15
weiyingde 友我希望你能继续跟进 并完成此代码,虽然你选择本意和我有所不同,我是只要表一余下不同,你是要 ...

是的，很多时候，我也狂狂论坛，对一些能够解决的问题，试一试身手，当然，由于学艺不精，会遇到一些障碍，好在会有很多朋友的指点和帮助，总会有结果的。
希望，大家一同进步。
谢谢关注。

weiyingde

lzxdy 发表于 2017-10-19 22:33
另外，上面中的d(rn2) = ""或d(brr(x, y)) = ""应该去掉，才符合原问题本义。

再次测试，发现字典统计的数字也不对，比实际数要多出几个，请测试并指点。