求助大神，如何对一组数据按要求进行自动筛选整理

達達SAMA

需求是这样的：

这个表中的第一行是变量，下面全都是这个变量的值。


后面需要对所有变量两两比较，进行2×2列联表分析，这样总计有9个变量，会产生36组对比（只看值为0或1的数据比较）。
具体表现为：
第一个变量为0，第二个变量为0的数量有多少
第一个变量为0，第二个变量为1的数量有多少
第一个变量为1，第二个变量为0的数量有多少
第一个变量为1，第二个变量为1的数量有多少
比如下图——


由于总的数据量很大，无法手动一个个筛选整理，所以求问大神们，有办法通过VBA实现吗？附件是例子和预期实现的效果，感激不尽！

z442933236

做了一个出来其它复制代码！

達達SAMA

z442933236 发表于 2021-6-21 23:50
做了一个出来其它复制代码！

1. [code]Sub test()
   
2. On Error Resume Next
   
3. Dim arr
   
4. Dim i, j As Long
   
5. arr = Sheet1.Range("a1:i" & Cells(Rows.Count, 1).End(xlUp).Row)
   
6. For i = 1 To UBound(arr)
   
7. For j = 1 To UBound(arr, 2)
   
8. If IsError(arr(i, j)) Then
   
9. arr(i, j) = ""
   
10. Else
    
11. arr(i, j) = arr(i, j)
    
12. End If
    
13. Next
    
14. Next
    
15. With Sheet1.Range("a1").Resize(UBound(arr), UBound(arr, 2))
    
16. .NumberFormat = "@"
    
17. .Value = arr
    
18. End With
    
19. End Sub
    
20. 
    
21. Sub test1()
    
22. Dim kk As Long
    
23. On Error Resume Next
    
24. Dim arr, brr, crr
    
25. 
    
26. arr = Sheet1.Range("a1:i" & Cells(Rows.Count, 1).End(xlUp).Row)
    
27. 'brr = Range("b1:b" & Cells(Rows.Count, 1).End(xlUp).Row)
    
28. 'crr = Range("c1:c" & Cells(Rows.Count, 1).End(xlUp).Row)
    
29. For j = 1 To UBound(arr, 2)
    
30. kk = Sheet2.UsedRange.Rows.Count
    
31. If j = 9 Then Exit Sub
    
32. For i = 2 To UBound(arr)
    
33. If arr(i, j) = 0 And arr(i, j + 1) = 0 Then
    
34.     x = x + 1
    
35. End If
    
36. If arr(i, j) = 0 And arr(i, j + 2) = 0 Then
    
37.     x1 = x1 + 1
    
38. End If
    
39. If arr(i, j) = 0 And arr(i, j + 3) = 0 Then
    
40.     x2 = x2 + 1
    
41. End If
    
42. If arr(i, j) = 0 And arr(i, j + 4) = 0 Then
    
43.     x3 = x3 + 1
    
44. End If
    
45. If arr(i, j) = 0 And arr(i, j + 5) = 0 Then
    
46.     x4 = x4 + 1
    
47. End If
    
48. If arr(i, j) = 0 And arr(i, j + 6) = 0 Then
    
49.     x5 = x5 + 1
    
50. End If
    
51. If arr(i, j) = 0 And arr(i, j + 7) = 0 Then
    
52.     x6 = x6 + 1
    
53. End If
    
54. If arr(i, j) = 0 And arr(i, j + 8) = 0 Then
    
55.     x7 = x7 + 1
    
56. End If
    
57. Next
    
58. Sheet2.Range("a" & kk) = arr(1, j) & "为0" & "||" & arr(1, j + 1) & "为0"
    
59. Sheet2.Range("b" & kk) = x
    
60. Sheet2.Range("a" & kk + 1) = arr(1, j) & "为0" & "||" & arr(1, j + 2) & "为0"
    
61. Sheet2.Range("b" & kk + 1) = x1
    
62. Sheet2.Range("a" & kk + 2) = arr(1, j) & "为0" & "||" & arr(1, j + 3) & "为0"
    
63. Sheet2.Range("b" & kk + 2) = x2
    
64. Sheet2.Range("a" & kk + 3) = arr(1, j) & "为0" & "||" & arr(1, j + 4) & "为0"
    
65. Sheet2.Range("b" & kk + 3) = x3
    
66. Sheet2.Range("a" & kk + 4) = arr(1, j) & "为0" & "||" & arr(1, j + 5) & "为0"
    
67. Sheet2.Range("b" & kk + 4) = x4
    
68. Sheet2.Range("a" & kk + 5) = arr(1, j) & "为0" & "||" & arr(1, j + 6) & "为0"
    
69. Sheet2.Range("b" & kk + 5) = x5
    
70. Sheet2.Range("a" & kk + 6) = arr(1, j) & "为0" & "||" & arr(1, j + 7) & "为0"
    
71. Sheet2.Range("b" & kk + 6) = x6
    
72. Sheet2.Range("a" & kk + 7) = arr(1, j) & "为0" & "||" & arr(1, j + 4) & "为0"
    
73. Sheet2.Range("b" & kk + 7) = x7
    
74. x = 0
    
75. x1 = 0
    
76. x2 = 0
    
77. x3 = 0
    
78. x4 = 0
    
79. x5 = 0
    
80. x6 = 0
    
81. x7 = 0
    
82. Next
    
83. 
    
84. 
    
85. x = 0
    
86. y = 0
    
87. Z = 0
    
88. k = 0
    
89. 'Debug.Print x, y, Z, k
    
90. End Sub

复制代码

不好意思又打扰您了，想请问一下这段代码假如需要处理更多变量的话应该怎么继续添加语句呢？[/code]