[已解决]大家好，求两个数组集运算的公式，谢谢！

gzminge · 发表于 2015-1-7 09:40

图中区域第2行至第6行是第一个数组集，第9行至第13行是第二个数组集。现在求把第一个数组集中有与第2个数组集相同的数组全部删减，把结果放在第16至第20行。

新建 Microsoft Office Excel 工作表 (2).zip (10.71 KB, 下载次数: 3)

爱疯 · 发表于 2015-1-7 10:42

本帖最后由爱疯于 2015-1-7 10:43 编辑

Sub Click()
Dim A, B, C, D
Dim i%, j&, s&, t$

A = Range("b2").CurrentRegion
B = Range("b9").CurrentRegion
ReDim C(1 To UBound(A), 1 To UBound(A, 2))
ReDim D(1 To 10 ^ 5 - 1)

'1）增加
For j = 1 To UBound(A, 2)
      s = 0
      For i = 1 To UBound(A)
         s = s + 10 ^ (i - 1) * A(i, j)
      Next i
      D(s) = s
Next j

'2）去除
For j = 1 To UBound(B, 2)
      s = 0
      For i = 1 To UBound(B)
         s = s + 10 ^ (i - 1) * B(i, j)
      Next i
      If D(s) = s Then D(s) = 0
Next j

'3）输出
s = 0
For j = 1 To UBound(D)
      If D(j) <> 0 Then
         t = Format(D(j), "00000")
         t = VBA.StrReverse(t)
         s = s + 1

         For i = 1 To UBound(C)
            C(i, s) = Mid(t, i, 1)
         Next i
      End If
Next j
[b16].Resize(UBound(C), UBound(C, 2)) = C
End Sub

2.rar (22.44 KB, 下载次数: 3)

爱疯 · 发表于 2015-1-7 11:12

Sub Click()
Dim A, B, C, D
Dim i%, j&, s&, t$

A = Range("b2").CurrentRegion
B = Range("b9").CurrentRegion
ReDim C(1 To UBound(A), 1 To UBound(A, 2))
ReDim D(0 To 10 ^ UBound(A) - 1)

'1）增加
For j = 1 To UBound(A, 2)
      s = 0
      For i = 1 To UBound(A)
         s = s + 10 ^ (i - 1) * A(i, j)
      Next i
      D(s) = s
Next j

'2）去除
For j = 1 To UBound(B, 2)
      s = 0
      For i = 1 To UBound(B)
         s = s + 10 ^ (i - 1) * B(i, j)
      Next i
      If D(s) = s Then D(s) = 0
Next j

'3）输出
s = 0
For j = 1 To UBound(D)
      If D(j) <> 0 Then
         t = Format(D(j), "00000")
         s = s + 1

         For i = 1 To UBound(C)
            C(UBound(C) + 1 - i, s) = Mid(t, i, 1)
         Next i
      End If
Next j
Rows("16:20").ClearContents
[b16].Resize(UBound(C), UBound(C, 2)) = C
End Sub

3.rar (18.53 KB, 下载次数: 4)

gzminge · 发表于 2015-1-8 09:42

爱疯发表于 2015-1-7 11:12
Sub Click()
Dim A, B, C, D
Dim i%, j&, s&, t$

谢谢老师！宏非常方便！
如果运算由减集变为交集，怎么改呢？
就是要把数组一和二相同的数组留下来，放在第16至20行。

爱疯 · 发表于 2015-1-8 10:41

4.rar (18.44 KB, 下载次数: 4)

gzminge · 发表于 2015-1-9 21:34

爱疯发表于 2015-1-8 10:41

套用到其他工作表，出现下标越界怎么解决呀？

爱疯 · 发表于 2015-1-9 21:48

发下你出错的工作簿

gzminge · 发表于 2015-1-9 22:02

爱疯发表于 2015-1-9 21:48
发下你出错的工作簿

如果套用于2007版的其他工作表，出现下标越界和溢出，是什么原因呢？
是不是工作表的数据量有限制？如果有1000列左右的数据还能正常使用吗？

4-2.zip (33.78 KB, 下载次数: 1)

爱疯 · 发表于 2015-1-9 22:38

Sub Click()
Dim A, B, C, d
Dim i, j, s, t$

A = Range("b2").CurrentRegion
B = Range("b9").CurrentRegion
ReDim C(1 To UBound(A), 1 To UBound(A, 2))
Set d = CreateObject("scripting.dictionary")

'1）增加A
For j = 1 To UBound(B, 2)
      t = ""
      For i = 1 To UBound(B)
         t = t & "," & B(i, j)
      Next i
      '       t = t & "|" & j
      d(t) = t
Next j

'2）去除
For j = 1 To UBound(A, 2)
      t = ""
      For i = 1 To UBound(A)
         t = t & "," & A(i, j)
      Next i

      '如果A这5个元素，不是B的，就放到C
      If d.exists(t) = False Then
         s = s + 1
         For i = 1 To UBound(C)
            C(i, s) = A(i, j)
         Next i
      End If
Next j

'3）输出
Rows("16:20").ClearContents
[b16].Resize(UBound(C), UBound(C, 2)) = C

End Sub

4-2B.rar (55.96 KB, 下载次数: 3)

gzminge · 发表于 2015-1-9 22:58

爱疯发表于 2015-1-9 22:38
Sub Click()
Dim A, B, C, d
Dim i, j, s, t$

谢谢！
现在好象只是减集运算，交集运算怎么改呀？

		自动登录	找回密码
密码			注册

[已解决]大家好，求两个数组集运算的公式，谢谢！

评分