singo1232001

回復 17# ziv976688

ziv976688

回復 14# ML089
測試成功
謝謝您的幫忙和指導~感恩

請教一下 :
Module 3  餘數登錄
執行起來會卡卡的~游標一值跳
如果把DATA!VB編輯器的列47  Call 餘數登錄 點為註解~
游標就正常不跳了。
請問 :
這是什麼原因 ?
是不是我的電腦有問題 ?
標示底色_ML089_V1.rar (107.08 KB)

下載次數: 3

2021-7-25 20:06

謝謝您

ziv976688

回復 13# n7822123
測試成功
謝謝您的幫忙和指導~感恩

不好意思，請教一下 :
  列8
  For Each Num In Split(Arr(2)(R, C), ",")
      餘數 = (Arr(1)(R, C) + Num - 1) Mod 49 + 1
請問 :
Num是指填入控制箱的期距數  Num = "25" 嗎?
還是只是變數 ?
謝謝您

ziv976688

回復 12# n7822123
測試成功
謝謝您的幫忙和指導~感恩

ML089

回復 11# ziv976688
是最後一列資料，我看錯了，修正如下
Sub 標示底色_ML089()
    Dim xD As Object, xS As Worksheet, xR As Range, SP, r
    Set xD = CreateObject("Scripting.Dictionary")
    For Each xS In Sheets(Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))    '取表格
        r = xS.[B65536].End(xlUp).Row
        For Each xR In xS.Range("A4:A" & xS.[A65536].End(xlUp).Row)    '取儲存格
            xR.Interior.ColorIndex = 0 '清底色
            'If xR > 0 And xR = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xR.Interior.ColorIndex = 8  '標示藍底色
            If Not xS.Range("M" & r, "S" & r).Find(xR, LookAt:=xlWhole) Is Nothing Then xR.Interior.ColorIndex = 8  '標示藍底色
        Next

        For Each xR In xS.Range("D2:J" & r - 1)    '取儲存格
            xR.Interior.ColorIndex = 0 '清底色
            For Each SP In Split(xR, ",")    '分開數字
                'If Val(SP) > 0 And Val(SP) = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xD(Val(SP)).Interior.ColorIndex = 8 '標示藍底色
                If Not xS.Range("M" & r, "S" & r).Find(Val(SP), LookAt:=xlWhole) Is Nothing Then xR.Interior.ColorIndex = 8: Exit For     '標示藍底色
            Next
        Next
    Next
End Sub

n7822123

回復 1# ziv976688

針對1樓需求~~版主已完成，再錦上添花一下~~

看你的序號從 1853~1878，若數列多

用陣列運算，速度應該會快一些

純數值才可以這樣做，改變儲存格顏色啥的，用儲存格就好~

Sub 餘數()
Dim Arr(1 To 2), Brr, Sh As Worksheet, Shs$
Shs = "準2進3 準3進4 準4進5 準5進6 準6進7 準7進8"
For Each Sh In Sheets(Split(Shs)): With Sh
  Rn& = .[B2].End(4).Row - 1: ReDim Brr(1 To Rn, 1 To 7)
  Arr(1) = .[M2].Resize(Rn, 7): Arr(2) = .[V2].Resize(Rn, 7)
  For R = 1 To Rn: For C = 1 To 7
    For Each Num In Split(Arr(2)(R, C), ",")
      餘數 = (Arr(1)(R, C) + Num - 1) Mod 49 + 1
      Brr(R, C) = Brr(R, C) & "," & Format(餘數, "00")
    Next Num
    Brr(R, C) = Mid(Brr(R, C), 2)
  Next C: Next R
  .[D30].Resize(Rn, 7) = Brr   '測試用
  '.[D2].Resize(Rn, 7) = Brr     '正確位置
End With: Next Sh
End Sub

n7822123

回復 11# ziv976688

用Match 做法寫給你

Sub 標示底色_Ex()
Dim Arr, Shs$, Num, Sh As Worksheet, Rg As Range
Shs = "準2進3 準3進4 準4進5 準5進6 準6進7 準7進8"
For Each Sh In Sheets(Split(Shs)): With Sh
  Arr = .[M2].End(4).Resize(, 7)
  Arr = Application.Transpose(Application.Transpose(Arr))  '轉一維
  For Each Rg In Union(.Range("A4:A52"), .Range("D2:J" & .[B65536].End(xlUp).Row - 1))
    Rg.Interior.ColorIndex = 0                           '清底色
    For Each Num In Split(Rg, ",")
      K = Application.Match(--Num, Arr, 0)                     '-- 轉數字比對
      If Not IsError(K) Then Rg.Interior.ColorIndex = 8  '標示藍底色
    Next Num
  Next Rg
End With: Next Sh
End Sub

ziv976688

回復 10# ML089
標示底色_ML089.rar (105.69 KB)

下載次數: 1

2021-7-25 17:41

  =>可按清除鍵測試
版主 :
您是不是誤解需求的意思了
If Not....Is Nothing.....
變成<>""的儲存格全部標示藍色
請賜正!謝謝您

ML089

回復 9# ziv976688

Sub 標示底色()
    Dim  xS As Worksheet, xR As Range, SP, r
   
    For Each xS In Sheets(Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8"))    '取表格
        r = xS.[B65536].End(xlUp).Row
        For Each xR In xS.Range("A4:A" & xS.[A65536].End(xlUp).Row)    '取儲存格
            'xR.Interior.ColorIndex = 0 '清底色
            If Not xS.Range("M2:S" & r).Find(xR) Is Nothing Then xR.Interior.ColorIndex = 8  '標示藍底色
        Next

        For Each xR In xS.Range("D2:J" & r - 1)    '取儲存格
            'xR.Interior.ColorIndex = 0 '清底色
            For Each SP In Split(xR, ",")    '分開數字
                If Not xS.Range("M2:S" & r).Find(Val(SP)) Is Nothing Then xR.Interior.ColorIndex = 8: Exit For    '標示藍底色
            Next
        Next
    Next
End Sub

ziv976688

回復 4# ML089
標示底色.rar (105.15 KB)

下載次數: 5

2021-7-25 16:06

=>可按清除鍵測試
不好意思，可否請版主賜正~
標示底色
Module 5
' If xR > 0 And xR = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xR.Interior.ColorIndex = 8  '標示藍底色
列7
=當A4:A52<>""的某儲存格之值~
有顯示在M:S有數字之最後一列的任一個儲存格時，
則A欄的該值之儲存格標示藍底色。

' If Val(SP) > 0 And Val(SP) = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xD(Val(SP)).Interior.ColorIndex = 8 '標示藍底色
列12
=當xS.Range("D2:J" & xS.[B65536].End(xlUp).Row - 1) <>""的某儲存格之任1個值~
有顯示在M:S最後一列的任一個儲存格時，
則xS.Range("D2:J" & xS.[B65536].End(xlUp).Row - 1)的該值之儲存格標示藍底色。

請問：
Module 5的列7和列12之程式碼要如何修正 ?
謝謝您