[已解决]批量求遗漏值的VBA代码要如何写,比较麻烦,繁琐,望能解决?

qiuzhuvba · 发表于 2014-12-6 16:57

本帖最后由 qiuzhuvba 于 2014-12-6 23:10 编辑

批量求遗漏值的VBA代码要如何写,比较麻烦,繁琐,望能解决?

表格jh表
jh表的B列是要分析的数据源.数据是01-11之间的11个数

如
B1=07 02 10 11 04

要统计其两位,三位,四位的遗漏值.
那么先要对其进行分解.

两位:就是07 02 10 11 04,这5个数字每两个组合,从小到大,不重复,就有10种.
三位:就是07 02 10 11 04,这5个数字每三个组合,从小到大,不重复,就有10种.
四位:就是07 02 10 11 04,这5个数字每四个组合,从小到大,不重复,就有5种.

分解成两位,有10种
02 04
02 07
02 10
02 11
04 07
04 10
04 11
07 10
07 11
10 11
分解成3位,有10种
02 04 07
02 04 10
02 04 11
02 07 10
02 07 11
02 10 11
04 07 10
04 07 11
04 10 11
07 10 11
分解为4位,有5种
02 04 07 10
02 04 07 11
02 04 10 11
02 07 10 11
04 07 10 11

得到分解的结果后,就是对其结果填充遗漏值了..

分解出来的10个两位,在表2的A列里找到自己的位置,相同的(出现的)就填0,不相同(没出现的)就自动累计1

如图所示--
QQ截图20141206163129.jpg

分解出来的10个三位,5个4位的也是如此....

例子表格里的表jh里只有40组数据要进行批量计算遗漏值,

感觉要手动填写,那非常累人.

批量计算遗漏值的VBA解法是要如何写呢..
请教各位老师..

````
表2 (2)的内容是例子 B1的10个两位的遗漏值填写结果.
表2,表3,表4为表jh里的40组数据的遗漏值的最终计算结果/
`````
附件下载:

20141206.rar (8.7 KB, 下载次数: 5)

qiuzhuvba · 发表于 2014-12-6 18:18

难度比较大..

期待老师们的解答

qiuzhuvba · 发表于 2014-12-6 22:42

各位老师晚安

qiuzhuvba · 发表于 2014-12-6 23:06

原先表格里的表3 表4 数据里的遗漏值计算错误..已重新上传,不好意思了.各位老师

学习学习vba · 发表于 2014-12-7 15:37

这个有点复杂

香川群子 · 发表于 2014-12-8 08:55

毫无难度……

香川群子 · 发表于 2014-12-8 10:32

因为是固定组合，所以就用了简单循环来做。

Sub test() 'by kagawa 2014/12/8
Dim ar, i&, i1&, i2&, i3&, i4&, k&, s, tms#
tms = Timer
Dim a1&(1 To 11)
Dim b1$(1 To 11)
For i1 = 1 To 11
b1(i1) = Right(0 & i1, 2)
Next
Dim a2&(1 To 10, 2 To 11)
ReDim b2(1 To WorksheetFunction.Combin(11, 2), 1 To 2)
k = 0
For i1 = 1 To 10
For i2 = i1 + 1 To 11
k = k + 1: a2(i1, i2) = k: b2(k, 1) = b1(i1) & " " & b1(i2)
Next i2, i1
Dim a3&(1 To 9, 2 To 10, 3 To 11)
ReDim b3(1 To WorksheetFunction.Combin(11, 3), 1 To 2)
k = 0
For i1 = 1 To 9
For i2 = i1 + 1 To 10
For i3 = i2 + 1 To 11
k = k + 1: a3(i1, i2, i3) = k: b3(k, 1) = b1(i1) & " " & b1(i2) & " " & b1(i3)
Next i3, i2, i1
Dim a4&(1 To 8, 2 To 9, 3 To 10, 4 To 11)
ReDim b4(1 To WorksheetFunction.Combin(11, 4), 1 To 2)
k = 0
For i1 = 1 To 8
For i2 = i1 + 1 To 9
For i3 = i2 + 1 To 10
For i4 = i3 + 1 To 11
k = k + 1: a4(i1, i2, i3, i4) = k: b4(k, 1) = b1(i1) & " " & b1(i2) & " " & b1(i3) & " " & b1(i4)
Next i4, i3, i2, i1
ar = Range("a1").CurrentRegion
Dim c&(1 To 5)
For i = 1 To UBound(ar)
s = Split(ar(i, 2))
Erase a1
For i1 = 0 To UBound(s)
a1(s(i1)) = 1
Next
k = 0
For i1 = 1 To 11
If a1(i1) Then k = k + 1: c(k) = i1
Next
For i1 = 1 To 4
For i2 = i1 + 1 To 5
k = a2(c(i1), c(i2)): b2(k, 2) = b2(k, 2) + 1
Next i2, i1
For i1 = 1 To 3
For i2 = i1 + 1 To 4
For i3 = i2 + 1 To 5
k = a3(c(i1), c(i2), c(i3)): b3(k, 2) = b3(k, 2) + 1
Next i3, i2, i1
For i1 = 1 To 2
For i2 = i1 + 1 To 3
For i3 = i2 + 1 To 4
For i4 = i3 + 1 To 5
k = a4(c(i1), c(i2), c(i3), c(i4)): b4(k, 2) = b4(k, 2) + 1
Next i4, i3, i2, i1
Next
' Debug.Print Format(Timer - tms, "0.000s")
Sheet2.Range("a1").Resize(UBound(b2), 2) = b2
Sheet3.Range("a1").Resize(UBound(b3), 2) = b3
Sheet4.Range("a1").Resize(UBound(b4), 2) = b4
MsgBox Format(Timer - tms, "0.000s")
End Sub

复制代码

香川群子 · 发表于 2014-12-8 17:30

重新看了一下题目，原来楼主要求的统计方法是到最近一期为止的遗漏状态……

按以下附件计算。

精灵学vba · 发表于 2014-12-26 15:30

香川群子真是高手哟

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

[已解决]批量求遗漏值的VBA代码要如何写,比较麻烦,繁琐,望能解决?

相关帖子