Board logo

標題: 格式化條件 [打印本頁]
作者: s13983037    時間: 2014-12-12 22:35     標題: 格式化條件

各位前輩大家好

請問大家,想把A欄的資料儲存格如果有包含F欄的資料就變成黃色,目前卡在抓F2欄位不會變色,,懇請各位幫忙,感謝..協助


    Worksheets(1).Columns("A:A").Select
    For d = 1 To 2
    Selection.FormatConditions.Add Type:=xlTextString, String:= _
        Range("F" & d), TextOperator:=xlContains
        S = Range("F" & d)
        MsgBox S
                    For i = 1 To 1
                        With Selection.FormatConditions(i).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = 65535
                        .TintAndShade = 0
                        On Error Resume Next
                        End With
                    Next
                    i = 0
    Next d
    'Selection.AutoFilter
    'ActiveSheet.Range("$A$1:$A$5000").AutoFilter Field:=1, Criteria1:=RGB(255 _
    '    , 255, 0), Operator:=xlFilterCellColor
        On Error Resume Next
作者: GBKEE    時間: 2014-12-13 06:17

回復 1# s13983037
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range
  4.     With Worksheets(1).Columns("A:A")
  5.         .Parent.Activate
  6.         Set Rng = .Range("F1")
  7.         Set Rng = .Range(Rng, Rng.End(xlDown))
  8.         .FormatConditions.Delete
  9.         With .SpecialCells(xlCellTypeConstants)
  10.             .Cells(1).Select
  11.             .FormatConditions.Add Type:=xlExpression, Formula1:="=MATCH(" & .Cells(1).Address(0, 0) & "," & Rng.Address(1, 1) & ",0)>0"
  12.             With .FormatConditions(1).Interior
  13.                 .ColorIndex = 6
  14.                 .PatternColorIndex = xlAutomatic
  15.             End With
  16.         End With
  17.     End With
  18. End Sub
複製代碼
作者: s13983037    時間: 2014-12-13 10:10

回復 2# GBKEE

GBKEE前輩您好
我想要規劃的樣子 是如圖1  , 如果F欄中的"AA"對應到 A欄中的 "AAB"的話就,無變更顏色,但如果對應到"AA c"的話,會對應到顏色...類似圖2這樣的,格式化條件是以特定文字對應...到F欄,麻煩您為小弟指點迷津,非常感謝您了{:3_59:}

圖1
[attach]19771[/attach]  


圖2
[attach]19773[/attach]
作者: GBKEE    時間: 2014-12-15 06:39

回復 3# s13983037
要說清楚,只要A欄每一儲存格的字串開頭在F欄中有出現就變色
ThisWorkbook物件模組的程式碼
  1. Option Explicit
  2. Private Sub Workbook_Open()
  3.     Run "SHEET1.Auto_Open", Range("A:A")
  4.     'SHEET1: Worksheet(1)->VBA的物件名稱
  5.     '你可修改
  6. End Sub
複製代碼
SHEET1物件模組的程式碼
  1. Option Explicit
  2. Dim Rng As Range, Ar
  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.     Dim R
  5.     If Rng Is Nothing Then Set_Rng
  6.     If Intersect(Target, Rng) Is Nothing Then
  7.         Auto_Open [a:a]
  8.     ElseIf Not Intersect(Target, Rng) Is Nothing Then
  9.         If Ar(Target.Row, 1) <> Target Then
  10.             With Range("a:a").SpecialCells(xlCellTypeConstants)
  11.                 For Each R In .SpecialCells(xlCellTypeConstants)
  12.                     If UCase(R) Like UCase(Target & "*") Then
  13.                         R.Interior.ColorIndex = 6
  14.                     Else
  15.                         R.Interior.ColorIndex = xlNo
  16.                     End If
  17.                    Next
  18.             End With
  19.         End If
  20.         Ar = Rng.Value
  21.     End If
  22. End Sub
  23. Private Sub Set_Rng()
  24.     Set Rng = Range("F1")
  25.     Set Rng = Range(Rng, Rng.End(xlDown))
  26.     Ar = Rng.Value
  27. End Sub

  29. Private Sub Auto_Open(Sheet_Rng As Range)
  30.     Dim E As Range, R As Range
  31.     Set_Rng
  32.     With Sheet_Rng
  33.         .Interior.ColorIndex = xlNo
  34.         If Application.CountA(.Cells) > 0 Then
  35.             For Each E In Rng
  36.                 For Each R In .SpecialCells(xlCellTypeConstants)
  37.                     If UCase(R) Like UCase(E) & "*" Then
  38.                         R.Interior.ColorIndex = 6
  39.                     End If
  40.                 Next
  41.             Next
  42.         End If
  43.     End With
  44. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)