返回列表 上一主題 發帖

[發問] 公式程式碼化

[發問] 公式程式碼化

本帖最後由 ziv976688 於 2021-7-24 01:07 編輯

不好意思,懇請各位大大指導和幫忙~
請將下列公式程式碼化。
謝謝!
公式程式碼化.rar (85.64 KB)
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")…類推。

本帖最後由 singo1232001 於 2021-7-24 23:12 編輯

回復 1# ziv976688
  1. Sub allsheet()   '<--執行這個
  2. Dim s As Worksheet
  3. For Each s In Worksheets
  4. If s.Name <> "DATA" Then Call 餘數登錄(s.Name)
  5. Next
  6. End Sub

  7. Sub 餘數登錄(sN)
  8. Set s = Sheets(sN)
  9. n = s.Columns("v:ab").Find("*", , -4163, , 1, 2).Row
  10. Dim ar
  11. ReDim ar(1 To n, 1 To 7)

  12. For i = 1 To n
  13. For j = 1 To 7
  14. x = s.Cells(i + 1, j + 21)
  15. If x <> "" Then
  16. x = Split(x, ",")
  17.     For Each x0 In x
  18.     x0 = (x0 + s.Cells(i + 1, j + 12)) Mod 49
  19.     If ar(i, j) <> "" Then ar(i, j) = ar(i, j) & "," & x0
  20.     If ar(i, j) = "" Then ar(i, j) = x0
  21.     Next
  22. End If
  23. Next
  24. Next
  25. s.[d2].Resize(n, 7) = ar
  26. End Sub
複製代碼

TOP

回復 2# singo1232001
  1. Sub allsheet()   '<--執行這個
  2. Dim s As Worksheet
  3. For Each s In Worksheets
  4. If s.Name <> "DATA" Then Call 餘數登錄(s.Name)
  5. Next
  6. End Sub

  7. Sub 餘數登錄(sN)
  8. Set s = Sheets(sN)
  9. n = s.Columns("v:ab").Find("*", , -4163, , 1, 2).Row
  10. Dim ar
  11. ReDim ar(1 To n, 1 To 7)

  12. For i = 1 To n
  13. For j = 1 To 7
  14. x = s.Cells(i + 1, j + 21)
  15. If x <> "" Then
  16. x = Split(x, ",")
  17.     For Each x0 In x
  18.     x0 = Format((x0 + s.Cells(i + 1, j + 12)) Mod 49,"00") <--忘了加00
  19.     If ar(i, j) <> "" Then ar(i, j) = ar(i, j) & "," & x0
  20.     If ar(i, j) = "" Then ar(i, j) = x0
  21.     Next
  22. End If
  23. Next
  24. Next
  25. s.[d2].Resize(n, 7) = ar
  26. End Sub
複製代碼

TOP

回復 1# ziv976688
Sub 餘數登錄()
    Dim xS As Worksheet, xV As Range, xD, SP
    Tm = Timer
    For Each xS In Sheets(Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))    '取表格
        For Each xV In xS.Range("V2:AB" & xS.[B65536].End(xlUp).Row)    '取儲存格
            xD = ""
            For Each SP In Split(xV, ",")    '分離字串
                SP = (SP + xV.Offset(, -9)) Mod 49: If SP = 0 Then SP = 49 'V2+M2 mod 49
                xD = xD & "," & Format(SP, "00")
            Next
            xV.Offset(30, -18) = Mid(xD, 2, 99) '測試用 位置下移30格
            'xV.Offset(, -18) = Mid(xD, 2, 99) '正確位置
        Next
    Next
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復  singo1232001
singo1232001 發表於 2021-7-24 23:43

公式程式碼化_singo1232001.rar (85.97 KB)
測試結果 :答案都是 FALSE
請再修正~謝謝您

TOP

本帖最後由 ziv976688 於 2021-7-25 09:08 編輯

回復 4# ML089
測試成功
程式碼加註解~受益良多
謝謝版主的耐心指導漢一再的熱心幫忙~感恩

TOP

回復 6# ziv976688

公式程式碼化_singo1232001.zip (117.49 KB)

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題