麻烦写个数字的亲疏加减

不可说7625

一、B4=928。写个每个数字的亲疏加减。规则如下

亲疏
9的左右两边两位数含本身为亲。即78901，剩下的为疏23456
2的左右两边两位数含本身为亲，即01234，剩下的为疏56789
8的左右两边两位数含本身为亲，即67890，剩下的为疏12345

结果如图所示



加减
9往后数5个数字为加，即01234为加，剩下的为减56789（减含本身）
2往后数5个数字为加，即34567为加，剩下的为减89012（减含本身）
8往后数5个数字为加，即90123为加，剩下的为减45678（减含本身）
结果如图所示



二、再写个判断下期数字出现的亲疏、加减组合
B5=173，1在C4=78901属于亲，7在F4=56789属于疏，3在H4=12345属于疏，结合起来亲疏疏，
1在J4=01234属于加，7在L4=34567属于加，3在N4=90123属于加，结合起来加加加，

结果在P5、Q5显示

三、麻烦用按钮运行，谢谢

ynzsvt

看看…………

饮冰e士

练一练，做了亲疏部分，其他的处理方法类似。

翁知江安

Sub test()
Dim i, j, k, t, s, p, n, nn, a As Integer
Dim m, q As String
Dim kk
Dim br, ar As Variant
ar = Sheet1.Range("a3:q" & Sheet1.[b65536].End(xlUp).Row)
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2) - 2)
m = "": q = ""
For i = 2 To UBound(ar)
   If Len(ar(i, 2)) = 3 Then
    For t = 1 To 3
        k = Val(Mid(ar(i, 2), t, 1))
         For n = 8 To 12
           s = (k + n) Mod 10
            m = m & CStr(s)
          Next
          br(i - 1, 2 * t - 1) = m
          m = ""
          For n = 13 To 17
           s = (k + n) Mod 10
            m = m & CStr(s)
          Next
          br(i - 1, 2 * t) = m
          m = ""
          For nn = 1 To 5
            p = (k + nn) Mod 10
           m = m & CStr(p)
          Next
          br(i - 1, 2 * t + 6) = m
          m = ""
          For nn = 6 To 10
            p = (k + nn) Mod 10
           m = m & CStr(p)
          Next
          br(i - 1, 2 * t + 7) = m
          m = ""
    Next
  End If
Next
For a = 3 To UBound(ar)
   If Len(ar(a, 2)) = 3 Then
    For t = 1 To 3
      k = Val(Mid(ar(a, 2), t, 1))
       For j = 2 * t - 1 To 2 * t
            If InStr(br(a - 2, j), k) > 0 Then
            m = m & ar(1, j + 2)
            End If
        Next
        For j = 2 * t + 6 To 2 * t + 7
            If InStr(br(a - 2, j), k) > 0 Then
            q = q & ar(1, j + 2)
            End If
        Next
     Next
     br(a - 1, 14) = m: m = ""
     br(a - 1, 15) = q: q = ""
    End If
Next
Sheet1.[c4].Resize(10000, UBound(br, 2)).ClearContents
Sheet1.[c4].Resize(UBound(br), UBound(br, 2)) = br
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正

清风竹-

请看附件。

不可说7625

清风竹- 发表于 2025-3-30 12:04
请看附件。

后面的亲疏、加减组合修改成下面这样吗


把下期计算出的亲疏、加减组合，，
比如
2004002的亲疏组合是亲疏疏，在R到Y对应的组合显示，对应S5，其他没有的位置以数字序列填充。
2004002的加减组合是加加加，在AA到AH对应的组合显示，对应Y5，其他没有的位置以数字序列填充。
如图

清风竹-

不可说7625 发表于 2025-3-30 20:56
后面的亲疏、加减组合修改成下面这样吗

请测试。。

不可说7625

清风竹- 发表于 2025-3-31 10:02
请测试。。

请问填充的颜色在哪设置？

清风竹-

不可说7625 发表于 2025-3-31 20:47
请问填充的颜色在哪设置？

用   条件格式   方法。