samwang

回復  cypd

不好意思各位先進...
針對初始檔案現有一問題出現



檔案部分 C 欄戶名原設有格式化條 ...
cypd 發表於 2022-7-22 17:00

設定格式化-->重複值，這樣應該可以吧?

samwang

回復  samwang

感謝您的回覆
所提供之方式有試過...筆數愈多時會造成所述繞圈圈問題
cypd 發表於 2022-7-23 09:18

10樓方式是用內建，你的11樓方式是用公式，所以有可能會比較慢
請在確認看看，謝謝

samwang

回復 11# cypd

請測試看看，謝謝
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr, xD, C%, T$, m&, i&
If Target.Column = 3 Then C = 3
If Target.Column = 4 Then C = 4
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("客戶基本資料")
    Arr = .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3))
    .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3)).Font.ColorIndex = 0
    .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3)).Interior.ColorIndex = 0
    For i = 1 To UBound(Arr)
        T = Arr(i, 1)
        If xD.Exists(T) Then
            m = xD(T)
            Cells(m, C).Font.ColorIndex = 3
            Cells(m, C).Interior.ColorIndex = 36
            Cells(i, C).Font.ColorIndex = 3
            Cells(i, C).Interior.ColorIndex = 36
        End If
        xD(T) = i
    Next
End With
End Sub

samwang

回復  samwang
太感謝您了...samwang

速度方面問題已 OK
經測試另有問題出現如下
若是 C 或 D 欄出現 ...
cypd 發表於 2022-7-24 11:33

修改如下移除.End(3)，請測試看看，謝謝
With Sheets("客戶基本資料")
    Arr = .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3))
    .Range(.Cells(1, C), .Cells(Rows.Count, C)).Font.ColorIndex = 0
    .Range(.Cells(1, C), .Cells(Rows.Count, C)).Interior.ColorIndex = 0

samwang

回復  samwang

太感謝您了...samwang

C 或 D 欄出現相同數據時...刪除下列數據之後儲存格會有填滿之 ...
cypd 發表於 2022-7-24 20:23

請測試看看，謝謝
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr, xD, C%, T$, m&, i&
If Target.Column = 3 Then C = 3
If Target.Column = 4 Then C = 4
If C = 0 Then Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("客戶基本資料")
    .Unprotect Password:="1234"  '解保護，密碼自行修改
     Arr = .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3))
     .Range(.Cells(1, C), .Cells(Rows.Count, C)).Font.ColorIndex = 0
     .Range(.Cells(1, C), .Cells(Rows.Count, C)).Interior.ColorIndex = 0
     For i = 1 To UBound(Arr)
         T = Arr(i, 1)
         If xD.Exists(T) Then
             m = xD(T)
             .Cells(m, C).Font.ColorIndex = 3
             .Cells(m, C).Interior.ColorIndex = 36
             .Cells(i, C).Font.ColorIndex = 3
             .Cells(i, C).Interior.ColorIndex = 36
         End If
         xD(T) = i
     Next
    .Unprotect Password:="1234"  '保護，密碼自行修改
End With
End Sub

samwang

回復 18# cypd

另外
.Unprotect Password:="1234"  '保護，密碼自行修改(多了 Un 無法進行保護)
已刪除 Un…測試 OK

>> 不好意思，沒有更新到，如您修改UN要刪除，謝謝

samwang

回復 20# cypd

VBA公式作動後
若 C 欄有新數據輸入時會造成 C1 底色不見
若 D 欄有新數據輸入時會造成 D1 底色不見
>> 改由第2列開始如下
With Sheets("客戶基本資料")
    .Unprotect Password:="1234"  '解保護，密碼自行修改
     Arr = .Range(.Cells(1, C), .Cells(Rows.Count, C).End(3))
     .Range(.Cells(2, C), .Cells(Rows.Count, C)).Font.ColorIndex = 0
     .Range(.Cells(2, C), .Cells(Rows.Count, C)).Interior.ColorIndex = 0

原保護工作表內之設定失效
(自行設定列格式及使用自動篩選無法使用...恢復預設值)
>> 依您原來的格式修改如下，請再試看看，謝謝
.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingRows:=True, AllowFiltering:=True '保護，密碼自行修改