返回列表 上一主題 發帖

[發問] 依欄位條件自動變色 與 儲存格內的公式向下填滿

回復 1# 蝕光迴狼
試試看
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim Rng(1 To 2) As Range
  4.     Set Rng(1) = Range("c7", Range("c" & Rows.Count).End(xlUp))
  5.     If Rng(1).Cells(1) = Range("c6") Then MsgBox "分數欄 沒有資料": Exit Sub
  6.    
  7.     With Range("A6").Resize(Rng(1).Rows.Count + 1, 7)
  8.         .Interior.ColorIndex = xlNone
  9.         .Sort Key1:=Range("C6"), Order1:=xlDescending, Header:=xlYes  '自動排列大小(遞減排序)
  10.     End With
  11.     For Each E In Rng(1)
  12.                         'A欄公式
  13.         E.Cells(1, -1) = "=IF(RC[2]="""","""",LOOKUP(RC[2],{0,701,1301,1501,1701},{""B"",""A"",""S"",""S+"",""SS""}))"
  14.         E.Cells(1, -1) = E.Cells(1, -1).Value
  15.                         'B欄公式
  16.         E.Cells(1, 0) = "=IF(RC[1]="""","""",RANK(RC[1],C[1]))"
  17.         E.Cells(1, 0) = E.Cells(1, 0).Value
  18.         Set Rng(2) = Range("H:H").Find(E.Cells(1, -1), LOOKAT:=xlWhole)
  19.         E.Cells(1, -1).Interior.ColorIndex = Rng(2).Interior.ColorIndex
  20.         E.Cells(1, 5).Interior.ColorIndex = Rng(2).Interior.ColorIndex
  21.     Next
  22. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# 蝕光迴狼
  1. For Each E In Rng(1)
  2.                         'A欄公式
  3.         E.Cells(1, -1) = "=IF(RC[2]="""","""",LOOKUP(RC[2],{0,701,1301,1501,1701},{""B"",""A"",""S"",""S+"",""SS""}))"
  4.         E.Cells(1, -1) = E.Cells(1, -1).Value
  5.                         'B欄公式
  6.         E.Cells(1, 0) = "=IF(RC[1]="""","""",RANK(RC[1],C[1]))"
  7.         E.Cells(1, 0) = E.Cells(1, 0).Value
  8.         '******** A欄公式的值 有在"情報區" 嗎? ************************
  9.         '不在會有【執行階錯誤'91'】 的錯誤是【沒有設定物件變變或With 區塊變數】
  10.       '********************************************************
  11.         Set Rng(2) = Range("H:H").Find(E.Cells(1, -1), LOOKAT:=xlWhole)
  12.         If Not Rng(2) Is Nothing Then  '條件式判斷: A欄公式的值 在"情報區" 有找到.排除A欄公式的值 不在"情報區"的錯誤
  13.             E.Cells(1, -1).Interior.ColorIndex = Rng(2).Interior.ColorIndex            
  14.             E.Cells(1, 5).Interior.ColorIndex = Rng(2).Interior.ColorIndex
  15.         End If
  16.     Next
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生沒有所有權,只有生命的使用權。
返回列表 上一主題