excel_vb实例

发表于 更新于 分类于 ， 阅读次数： 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
Attribute VB_Name = "模块1"
Sub star()
    t = Timer                                   '开始的时间
    Sheets("list").Activate                     '激活表格
    x = Cells.Columns.Count                     '计算表格的总列数
    y = Cells.Rows.Count                        '计算表格的总行数
    Cells.ClearFormats
    [a6].Resize(y - 6, x).ClearContents         '将数据区以外的单元格内容清空
'    [h3].Resize(y - 2, x - 7).ClearContents

    [a1].Resize(6, 18).RowHeight = 26
    [a1].Resize(6, 18).ColumnWidth = 5
    Range("a1:e5, h2:t2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Name = "等线"
        .Font.Size = 16
    End With

    Range("h2:r2").Font.Color = -16776961
    bt = Array("大号个数", "奇数个数", "质数个数", "落子行数", "落子列数", "首号最小", "末号最大", "首号路数", "末号路数", "胆码", "杀码")
    Range("h1：t1").WrapText = True
    Range("h1：t1").HorizontalAlignment = xlCenter

    arz = Array(2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31)
    h1 = Array(1, 2, 3, 4, 5, 6, 7)
    h2 = Array(8, 9, 10, 11, 12, 13, 14)
    h3 = Array(15, 16, 17, 18, 19, 20, 21)
    h4 = Array(22, 23, 24, 25, 26, 27, 28)
    h5 = Array(29, 30, 31, 32, 33, 34, 35)
    '分别将1--35装入到7列中，以数组的方式存储
    l1 = Array(1, 8, 15, 22, 29)
    l2 = Array(2, 9, 16, 23, 30)
    l3 = Array(3, 10, 17, 24, 31)
    l4 = Array(4, 11, 18, 25, 32)
    l5 = Array(5, 12, 19, 26, 33)
    l6 = Array(6, 13, 20, 27, 34)
    l7 = Array(7, 14, 21, 28, 35)

    For x = 0 To 10
        Cells(1, x + 8) = bt(x)
    Next
'统计近5期的号码，将未出现的号码取出来，并装进数组ar0中。
'按1到35的顺序检查，不存在的取出来。
'这里用到了重定义数组ReDim ar0(1 to 2) 以及 ReDim Preserve ar0(1 To y)。
'因为开始并不知道符合条件的个数，在不清楚数组个数的情况下，用这个办法解决。

    ReDim ar0(1 To 2)
    y = 1
    For x = 1 To 35
    n = 0
        For i = 1 To 5
            For j = 1 To 5
                If Cells(i, j) = x Then
                    n = n + 1
                End If
            Next
        Next
        If n = 0 Then
            ar0(y) = x
            y = y + 1
            ReDim Preserve ar0(1 To y)
        Else
        End If
5    Next
    '数组中最后一个会出现一个空值，将其去掉
    If ar0(y) = "" Then ReDim Preserve ar0(1 To y - 1)



'统计近5期的号码，将存在的号码取出来，并装进数组ar0中。
'按1到35的顺序检查，存在的取出来。
'这里用到了重定义数组ReDim ar0(1 to 2) 以及 ReDim Preserve ar0(1 To y)。
'因为开始并不知道符合条件的个数，在不清楚数组个数的情况下，用这个办法解决。


    ReDim ar1(1 To 2)
    y = 1
    For x = 1 To 35
        For i = 1 To 5
            For j = 1 To 5
                If Cells(i, j) = x Then
                    If y = 1 Then
                        ar1(y) = Cells(i, j)
                        y = y + 1
                        GoTo 15
                    Else
                        If Cells(i, j) <> ar1(y - 1) Then
                            ar1(y) = Cells(i, j)
                                y = y + 1
                                ReDim Preserve ar1(1 To y)
                                GoTo 15
                        Else
                            y = y
                        End If
                    End If
                End If
            Next
        Next
15    Next
    '数组中最后一个会出现一个空值，将其去掉
    If ar1(y) = "" Then ReDim Preserve ar1(1 To y - 1)


    '将数组ar0中的数据取出，并将其按数值大小分成5行7列
'并写入到单元格cells(8,1):cells(12,7)

    For Z = 1 To UBound(ar0)
        If ar0(Z) <= 7 Then
            x = 8
        ElseIf ar0(Z) <= 14 Then
            x = 9
        ElseIf ar0(Z) <= 21 Then
            x = 10
        ElseIf ar0(Z) <= 28 Then
            x = 11
        ElseIf ar0(Z) <= 35 Then
            x = 12
        End If
        y = 1
20      If Cells(x, y) = 0 Then
            Cells(x, y) = ar0(Z)
        Else
            y = y + 1
            GoTo 20
        End If
    Next

'将数组ar1中的数据取出，并将其按数值大小分成5行7列
'将数组ar0中的数据取出，并将其按数值大小分成5行7列
'并写入到单元格cells(13,1):cells(17,7)

    For Z = 1 To UBound(ar1)
        If ar1(Z) <= 7 Then
            x = 14
        ElseIf ar1(Z) <= 14 Then
            x = 15
        ElseIf ar1(Z) <= 21 Then
            x = 16
        ElseIf ar1(Z) <= 28 Then
            x = 17
        ElseIf ar1(Z) <= 35 Then
            x = 18
        End If
        y = 1
25      If Cells(x, y) = 0 Then
            Cells(x, y) = ar1(Z)
        Else
            y = y + 1
            GoTo 25
        End If
        Next

'将数组ar1数据按照组合方式组合成5个一组的号码，并存放于数组ar2
    x = UBound(ar1)
    x = x * (x - 1) * (x - 2) * (x - 3) * (x - 4) / 120
    y = UBound(ar0)
    y = y * (y - 1) * (y - 2) * (y - 3) * (y - 4) / 120
    x = x + y
    ReDim ar2(1 To x, 1 To 5)
    x = 1
    For i1 = 1 To UBound(ar1) - 4
        For i2 = i1 + 1 To UBound(ar1) - 3
            For i3 = i2 + 1 To UBound(ar1) - 2
                For i4 = i3 + 1 To UBound(ar1) - 1
                    For i5 = i4 + 1 To UBound(ar1)
                        ar2(x, 1) = ar1(i1)
                        ar2(x, 2) = ar1(i2)
                        ar2(x, 3) = ar1(i3)
                        ar2(x, 4) = ar1(i4)
                        ar2(x, 5) = ar1(i5)
                        x = x + 1
                    Next
                Next
            Next
        Next
    Next

    For i1 = 1 To UBound(ar0) - 4
        For i2 = i1 + 1 To UBound(ar0) - 3
            For i3 = i2 + 1 To UBound(ar0) - 2
                For i4 = i3 + 1 To UBound(ar0) - 1
                    For i5 = i4 + 1 To UBound(ar0)
                        ar2(x, 1) = ar0(i1)
                        ar2(x, 2) = ar0(i2)
                        ar2(x, 3) = ar0(i3)
                        ar2(x, 4) = ar0(i4)
                        ar2(x, 5) = ar0(i5)
                        x = x + 1
                    Next
                Next
            Next
        Next
    Next

'下面对未出现的号码进行整理筛选
'将数组ar0中的数据按照组合方式组合成5个一组的号码，并存放于数组ar2
'    x = UBound(ar0)
'    x = x * (x - 1) * (x - 2) * (x - 3) * (x - 4) / 120
'    y = UBound(ar2)
'    Z = x + y
'    ReDim ar2(1 To Z, 1 To 5)
'    x = y + 1
'    For i1 = 1 To UBound(ar0) - 4
'        For i2 = i1 + 1 To UBound(ar0) - 3
'            For i3 = i2 + 1 To UBound(ar0) - 2
'                For i4 = i3 + 1 To UBound(ar0) - 1
'                    For i5 = i4 + 1 To UBound(ar0)
'                        ar2(x, 1) = ar0(i1)
'                        ar2(x, 2) = ar0(i2)
'                        ar2(x, 3) = ar0(i3)
'                        ar2(x, 4) = ar0(i4)
'                        ar2(x, 5) = ar0(i5)
'                        x = x + 1
'                    Next
'                Next
'            Next
'        Next
'    Next


        j = 10
        For x = 1 To UBound(ar2)
            If Cells(2, 17) = "" Then GoTo 40
            n = 0
            For y = 1 To 5
                If Cells(2, 17) = ar2(x, y) Then n = n + 1
            Next
            If n = 0 Then GoTo 100
40
            If Cells(2, 18) = "" Then GoTo 45
            n = 0
            For y = 1 To 5
                If Cells(2, 18) = ar2(x, y) Then n = n + 1
            Next
            If n > 0 Then GoTo 100


45      '判断首号码，条件:最小值、路数
        If Cells(2, 13) = "" And Cells(2, 15) = "" Then GoTo 50                              '若条件为空，则放弃判断跳转到下一个条件判断
        If ar2(x, 1) < Cells(2, 13).Value And ar2(x, 1) Mod 3 <> Cells(2, 15) Then GoTo 100   '若条件判断不成立，则跳转到下一组号码

50      '判断末号码，条件：最大值、路数
        If Cells(2, 14) = "" Or Cells(2, 16) = "" Then GoTo 55
        If ar2(x, 5) > Cells(2, 14) Or ar2(x, 5) Mod 3 <> Cells(2, 16) Then GoTo 100

55      '判断大号的个数。统计大于18的数字个数
        n = 0
        For y = 1 To 5
        If Cells(2, 8) = "" Then GoTo 60
        If ar2(x, y) > 18 Then n = n + 1
        Next
        If n <> Cells(2, 8).Value Then GoTo 100


60       '统计奇数的个数
        n = 0
        If Cells(2, 9) = "" Then GoTo 65
        For y = 1 To 5
            If ar2(x, y) Mod 2 = 1 Then n = n + 1
        Next
        If n <> Cells(2, 9).Value Then GoTo 100

65       '统计质数的个数
        n = 0
        For y = 1 To 5
            If Cells(2, 10) = "" Then GoTo 70
            For Each i In arz
                If i = ar2(x, y) Then n = n + 1
            Next
        Next
        If n <> Cells(2, 10).Value Then GoTo 100


70      '统计号码落子在第1行的个数
            n1 = 0
            For y = 1 To 5
                For Each i In h1
                    If i = ar2(x, y) Then n1 = n1 + 1
                Next
            Next

71      '统计号码落子在第2行的个数
            n2 = 0
            For y = 1 To 5
                For Each i In h2
                    If i = ar2(x, y) Then n2 = n2 + 1
                Next
            Next

73      '统计号码落子在第3行的个数
            n3 = 0
            For y = 1 To 5
                For Each i In h3
                    If i = ar2(x, y) Then n3 = n3 + 1
                Next
            Next

74      '统计号码落子在第4行的个数
            n4 = 0
            For y = 1 To 5
                For Each i In h4
                    If i = ar2(x, y) Then n4 = n4 + 1
                Next
            Next

75       '统计号码落子在第5行的个数
            n5 = 0
            For y = 1 To 5
                For Each i In h5
                    If i = ar2(x, y) Then n5 = n5 + 1
                Next
            Next

            If n1 > 0 Then n1 = 1
            If n2 > 0 Then n2 = 1
            If n3 > 0 Then n3 = 1
            If n4 > 0 Then n4 = 1
            If n5 > 0 Then n5 = 1

76      '统计落子的行数
            If n1 + n2 + n3 + n4 + n5 <> Cells(2, 11) Then GoTo 100

81      '统计号码落子在第1列的个数
            n1 = 0
            For y = 1 To 5
                For Each i In l1
                    If i = ar2(x, y) Then n1 = n1 + 1
                Next
            Next
            If n1 > 2 Then GoTo 100

82      '统计号码落子在第2列的个数
            n2 = 0
            For y = 1 To 5
                For Each i In l2
                    If i = ar2(x, y) Then n2 = n2 + 1
                Next
            Next
            If n2 > 2 Then GoTo 100

83     '统计号码落子在第3列的个数
            n3 = 0
            For y = 1 To 5
                For Each i In l3
                    If i = ar2(x, y) Then n3 = n3 + 1
                Next
            Next
            If n3 > 2 Then GoTo 100

84      '统计号码落子在第4列的个数
            n4 = 0
            For y = 1 To 5
                For Each i In l4
                    If i = ar2(x, y) Then n4 = n4 + 1
                Next
            Next
            If n4 > 2 Then GoTo 100

85      '统计号码落子在第5列的个数
            n5 = 0
            For y = 1 To 5
                For Each i In l5
                    If i = ar2(x, y) Then n5 = n5 + 1
                Next
            Next
            If n5 > 2 Then GoTo 100

86      '统计号码落子在第6列的个数
            n6 = 0
            For y = 1 To 5
                For Each i In l6
                    If i = ar2(x, y) Then n6 = n6 + 1
                Next
            Next
            If n6 > 2 Then GoTo 100


87      '统计号码落子在第7列的个数
            n7 = 0
            For y = 1 To 5
                For Each i In l7
                    If i = ar2(x, y) Then n7 = n7 + 1
                Next
            Next
            If n7 > 2 Then GoTo 100
88
            If n1 > 0 Then n1 = 1
            If n2 > 0 Then n2 = 1
            If n3 > 0 Then n3 = 1
            If n4 > 0 Then n4 = 1
            If n5 > 0 Then n5 = 1
            If n6 > 0 Then n6 = 1
            If n7 > 0 Then n7 = 1
            If n1 + n2 + n3 + n4 + n5 + n6 + n7 <> Cells(2, 12) Then GoTo 100


            For Z = 1 To 5
                Cells(j, Z + 7) = ar2(x, Z)
            Next
            j = j + 1


100    Next

        If j > 10 Then Range("h10:l" & j - 1).Select

        t = Timer - t
End Sub