[發問] 公式程式碼化

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

57^#

發表於 2021-7-29 14:47 | 只看該作者

本帖最後由 ziv976688 於 2021-7-29 15:14 編輯

回復 56# ML089

真不好意思，小BUG不斷。

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

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

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

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

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

56^#

發表於 2021-7-29 13:51 | 只看該作者

本帖最後由 ML089 於 2021-7-29 13:54 編輯

回復 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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

55^#

發表於 2021-7-29 03:41 | 只看該作者

本帖最後由 ziv976688 於 2021-7-29 03:45 編輯

回復 37# ML089

餘數各取1_0729.rar (100.88 KB)
版主 :
不好意思，又有一個小Bug~
準5進6!A4=""
A4應該=46 。
懇請您賜正~謝謝您

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

54^#

發表於 2021-7-29 02:32 | 只看該作者

本帖最後由 ziv976688 於 2021-7-29 02:50 編輯

回復 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

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

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

53^#

發表於 2021-7-29 00:30 | 只看該作者

本帖最後由 ziv976688 於 2021-7-29 00:40 編輯

回復 52# ML089
版主 :
感謝您的關心

那時候~是提問A4:A52=D2:J26的餘數各取1
您要確定A欄是否為最多是2位數的整數?

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

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

52^#

發表於 2021-7-28 15:50 | 只看該作者

回復 50# ziv976688

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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

51^#

發表於 2021-7-28 14:32 | 只看該作者

回復 42# n7822123
已修正~
修正後執行正常(不到2秒)

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

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

50^#

發表於 2021-7-28 14:03 | 只看該作者

本帖最後由 ziv976688 於 2021-7-28 14:13 編輯

回復 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

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

49^#

發表於 2021-7-28 12:56 | 只看該作者

回復 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 ，還是負數怎麼辦?

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式