[發問] 公式程式碼化

ziv976688

不好意思，懇請各位大大指導和幫忙~
請將下列公式程式碼化。
謝謝！
公式程式碼化.rar (85.64 KB)

下載次數: 8

2021-7-24 00:57

Sheets("準2進3")!D2的原公式
=LEFT(TEXT(SUM(TEXT(MOD(M2+(0&TRIM(MID(SUBSTITUTE(V2,",","         "),1+{0,1,2,3,4}*9,9))),49),"[=0]!49")*10^{8,6,4,2,0}),"00!,00!,00!,00!,00"),IF(V2="",0,2+3*(LEN(V2)-LEN(SUBSTITUTE(V2,",",)))))
右拉到J2，再下拉到.Range("J" & .[B2].End(xldown).row - 1) 填滿

Module 1
文字說明：
備註：
1_要相加的2個目標儲存格=M:S和V:AB二個區段之同列等欄距(間隔8欄)的各儲存格。
2_VB2:AB" & .[B2].End(xldown).row - 1) = ""的儲存格不計算(略過)。
3_餘數=0時，視同=49。   
4_有顯示2個(含)以上時，則以","符號區隔。
實例說明：
Sheets("準2進3")
當V2<>""時，則D2=(M2的值+V2的值)/49 =>取餘數
EX：D2 =MOD(11+8,49)=19
EX：D2 =MOD(11+27,49)=38
即D2=19,38
：
：
當AA2<>""時，則I2=(R2的值+AA2的值)/49 =>取餘數
EX：I2 =MOD(42+30,49)=23
即I2=23
：
：
當W13<>""時，則E13=(N13的值+W13的值)/49 =>取餘數
EX：E13 =MOD(04+0,49)=04
EX：E13 =MOD(04+45,49)=49
即E13=04,49
：
：
當AB26<>""時，則J26=(S26的值+AB26的值)/49 =>取餘數
EX：J26=MOD(02+9,49)=11
即J26= 11

其餘…Sheets("準3進4")~ Sheets("準7進8")…類推。

ziv976688

回復 56# ML089

真不好意思，小BUG不斷。

版主 :
您不要這麼說，您願意指導，我已經是感激不盡了

要不是您不厭其煩的修正 Bug，我也沒機會學會正確的語法~
例如這一次的Bug，我是仔細的端詳整篇程式碼，但就是瞧不出 Bug是在哪裡?
也曾試將N>1改為N>=1，但失敗了~
結果是將N>0和N>1分別判斷就可以解決。

謝謝您的耐心指導和幫忙~感恩

PS : 54樓~ If 餘數 = 0 Then 餘數 = 49 的語法也是向您學習來的

ML089

回復 55# ziv976688

真不好意思，小BUG不斷。
Sub 餘數各取1()
    Dim xD As Object, xS As Worksheet, xR As Range, SP, N
    Set xD = CreateObject("Scripting.Dictionary")
   
    For Each xS In Sheets(Split("準2進3 準3進4 準4進5 準5進6 準6進7 準7進8"))    '取表格
        For Each xR In xS.Range("D2:J" & xS.[B65536].End(xlUp).Row)    '取儲存格
            For Each SP In Split(xR, ",")    '分開數字
                If Val(SP) > 0 Then xD(Val(SP)) = ""    '字典組合
            Next
        Next
        N = xD.Count
        xS.[A2:A110].ClearContents    '清除儲存格內容
        xS.[A2] = IIf(N = 0, "", N & "個")
        xS.[A3] = "號碼"
       If N > 0 Then
            With xS.[A4].Resize(N)
                .Value = Application.Transpose(xD.keys)
                'N > 1時才需要排序，不然會錯
                If N > 1 Then .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
            End With
        End If
        xD.RemoveAll
    Next
End Sub

ziv976688

回復 37# ML089
餘數各取1_0729.rar (100.88 KB)

下載次數: 2

2021-7-29 03:42

版主 :
不好意思，又有一個小Bug~
準5進6!A4=""
A4應該=46 。
懇請您賜正~謝謝您

ziv976688

回復 13# n7822123
請教您 :
列9 餘數 = (Arr(1)(R, C) + Num - 1) Mod 49 + 1  '加算Mod(M2+V2,49)

如果將貴程式碼改為減算，並將其差值轉為絕對值，使其都為正數
餘數 = (Abs(Arr(1)(R, C) - Num) - 1) Mod 49 + 1    '減算Mod(ABS(M2-V2),49)
但這樣改~會有一個小Bug : 當餘數=0 時，不會自動轉為49
必須再加  If 餘數 = 0 Then 餘數 = 49

請問 :以貴原程式碼要將差值改為絕對值的正確語法 ?
謝謝您

ziv976688

回復 52# ML089
版主 :
感謝您的關心
那時候~是提問A4:A52=D2:J26的餘數各取1
您要確定A欄是否為最多是2位數的整數?

沒有您耐心的幫我將程式碼流程全部重新整理，
我是無法順利完成本次各分拆項的問題需求~感恩

ML089

回復 50# ziv976688

了解，數字若是0~48就沒有問題
因為之前寫公式有問過你，數字是否控制在99以下，所以有點誤會。

ziv976688

回復 42# n7822123
已修正~
修正後執行正常(不到2秒)
謝謝您的指導和幫忙~感恩

ziv976688

回復 49# ML089
版主 :
謝謝您的提醒

For Each SP In Split(xV, ",")
:
:
Next
xV不是已限制在0 To 48了嗎?
還是我又錯了
如果我又誤解程式碼的意涵~懇請賜正。
謝謝您

准大的參數登錄(Module 2)
Sub 參數登錄()
    Dim xS As Worksheet, xD, Arr(6), Brr, R&, i&, j%, k%, x%, N%, T$
    Set xD = CreateObject("Scripting.Dictionary")
    For Each xS In Sheets(Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))
        xD.RemoveAll
        R = xS.[ac65536].End(xlUp).Row - 1
        N = N + 1: If R < 1 Then GoTo s01
        ReDim Brr(1 To R - 1, 1 To 7)
        For k = 0 To N
            Arr(k) = xS.[ae2].Cells(1, k * 9 + 1).Resize(R, 7)
            For j = 1 To 7
                xD(Arr(k)(R, j) & "|" & k) = 1
            Next j
        Next k
        '--------------------------------------
        For i = 1 To R - 1
            For j = 1 To 7
                For x = 0 To 48
                    For k = 0 To N
                       ' T = (Arr(k)(i, j) + x) Mod 49 & "|" & k
                        V = (Arr(k)(i, j) - x) Mod 49
                        If V < 0 Then V = V + 49
                        T = V & "|" & k
                        If xD(T) = 0 Then GoTo x001
                    Next k
                    Brr(i, j) = Brr(i, j) & IIf(Brr(i, j) = "", "", ",") & x
x001:                     Next x
            Next j
        Next i
        '-------------------------------------
        With xS.[v2].Resize(R - 1, 7) '登錄位置
            .NumberFormatLocal = "@"
            .Value = Brr
        End With
s01:         Next
End Sub

ML089

回復 48# ziv976688


B式 : 當-SP之後的差值=負數時，則SP自動再+49轉為正數(即如=一般的函數計算)
SP = (xV.Offset(, -9) - SP + 49) Mod 49: If SP = 0 Then SP = 49  'M2-V2 mod 49

若是
11-90 = -79，再+49變成 -30 ，還是負數怎麼辦?