求 数字号码的属性

damin369

学习求教：是否能通过VBA达成 通过运算按钮可以得到结果： 最新一期的数字号码（最后一行），总共7个， 要求可以自动显示每个号的属性： 1. 冷热：  本期之前连续10期没出过认为是冷号（前后区分别单独考虑）；    否则为热号 2. 奇偶：  号码的奇偶性； 3. 红蓝绿：每个颜色对应一个数组， 号码在[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] 为绿； 4. 针对后区的号码，还有大小的属性：  ≤6为 小；＞6为 大。 比如2024014 这一期的号码为：4 5 16 21 31 9 11   每个号码的属性如下： 4： 热 偶 红 5： 热 奇 红 16：热 偶 蓝 21：热 奇 蓝 31：冷 奇 绿 9： 热 奇 红 大 11：热 奇 红 大 结果 输出到“号码属性”工作表中的最后一行（对应期数） 表一：每一期的号码数字 表二：号码属性

3190496160

没什么技术难度，就是繁琐的if判断而已，
但是，不明白的是：楼主的表述似乎跟表格要呈现的结果不一致，

3190496160

Sub 判断()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("号码数据")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 3 Then MsgBox "号码数据为空！": End
    ar = .Range("a2:i" & r)
End With
With Sheets("号码属性")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    br = .Range("a1:bb" & rs)
    If r < 13 Then
        ks = 2
    Else
        ks = r - 11
    End If
    For j = 2 To UBound(br, 2)
        If br(2, j) = "" Then br(2, j) = br(2, j - 1)
        zd = br(2, j) & "|" & br(3, j)
        d(zd) = j
    Next j
    For j = 2 To UBound(ar, 2)
        sl = 0
        zf = ar(UBound(ar), j)
        For i = ks To UBound(ar) - 1
            If ar(i, j) = zf Then
                sl = sl + 1
            End If
        Next i
        If sl > 0 Then
            bs = "热"
        Else
            bs = "冷"
        End If
        If zf <= 12 Then
            ys = "红"
        ElseIf zf > 12 And zf <= 24 Then
            ys = "蓝"
        ElseIf zf > 25 Then
            ys = "绿"
        End If
        If zf Mod 2 = 0 Then
            jo = "偶"
        Else
            jo = "奇"
        End If
        If zf <= 6 Then
            dx = "小"
        Else
            dx = "大"
        End If
        rr = Array(bs, ys, jo, dx)
        For s = 0 To UBound(rr)
            zd = ar(1, j) & "|" & rr(s)
            lh = d(zd)
            If lh <> "" Then
                br(UBound(br), lh) = rr(s)
            End If
        Next s
    Next j
    br(UBound(br), 1) = ar(UBound(ar), 1)
    .Cells(rs, 1).Resize(1, UBound(br, 2)) = Application.Index(br, UBound(br), 0)
    .Cells(rs, 1).Resize(1, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

结果为认真核对，仅供参考
求自动显示 数字号码的属性.rar (27.72 KB, 下载次数: 10)

2024-2-2 18:02 上传

点击文件名下载附件

damin369

3190496160 发表于 2024-2-2 18:01
Sub 判断()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

本来我想打100分的，网站设置的最多评2分。感谢大神！

3190496160

damin369 发表于 2024-2-3 08:33
本来我想打100分的，网站设置的最多评2分。感谢大神！

你也仅仅打了一分呀，哈哈哈哈

damin369

3190496160 发表于 2024-2-3 08:38
你也仅仅打了一分呀，哈哈哈哈

补啦