返回列表 上一主題 發帖

[發問] 請簡化錄製的程式碼。

本帖最後由 GBKEE 於 2019-5-22 07:35 編輯

回復 3# ziv976688

依你檔案的程式碼所簡化的迴圈
試試看
  1. Option Explicit
  2. Sub 格式化條件()
  3.     Dim Rng As Range, AR(1 To 3) As String,i As Integer
  4.     Set Rng = Range("B2:F2")     '第一個範圍
  5.     For i = 0 To 9                           '10範圍要處裡
  6.         With Rng
  7.             '**Rng.Address                  範圍的絕對位置 : $B2:$F2
  8.             '**Rng(1).Address(0, 0)     範圍的第一個Cell 相對位置 B2
  9.             ' *公式一"=(B2=MAX($B2:$F2))*(B2>0)"
  10.             AR(1) = "=(" & Rng(1).Address(0, 0) & "=MAX(" & Rng.Address & "))*(" & Rng(1).Address(0, 0) & ">0)"
  11.             '* 公式二"=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=2)*(B2>0)"
  12.             AR(2) = "=(SUMPRODUCT((" & Rng(1).Address(0, 0) & "<=" & Rng.Address & ")/COUNTIF(" & Rng.Address & "," & Rng.Address & "))=2)*(" & Rng(1).Address(0, 0) & ">0)"
  13.             '* 公式三"=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=3)*(B2>0)"
  14.             AR(3) = "=(SUMPRODUCT((" & Rng(1).Address(0, 0) & "<=" & Rng.Address & ")/COUNTIF(" & Rng.Address & "," & Rng.Address & "))=3)*(" & Rng(1).Address(0, 0) & ">0)"
  15.             .Select
  16.             .FormatConditions.Delete
  17.             .FormatConditions.Add Type:=xlExpression, Formula1:=AR(1)
  18.             .FormatConditions(1).Interior.ColorIndex = 43
  19.             .FormatConditions.Add Type:=xlExpression, Formula1:=AR(2)
  20.             .FormatConditions(2).Interior.ColorIndex = 8
  21.             .FormatConditions.Add Type:=xlExpression, Formula1:=AR(3)
  22.             .FormatConditions(3).Interior.ColorIndex = 37
  23.         End With
  24.         Set Rng = Rng.Offset(, Rng.Columns.Count)  '**下一個範圍
  25.     Next
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 10# ziv976688
查看Vba說明  Address 屬性 ,自行試試修改


最後一段(第10段)$AU : $AX2  ->只有4欄
少一欄就減1
  1. Set Rng = Rng.Offset(, IIf(i < 9, Rng.Columns.Count, Rng.Columns.Count - 1))
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# ziv976688

請修正為
  1. Set Rng = Rng.Offset(, IIf(i < 8, Rng.Columns.Count, Rng.Columns.Count - 1)) '**下一個範圍
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 15# ziv976688

對不起啦,沒認真看你的問題
應加上
  1. Set Rng = Rng.Offset(, Rng.Columns.Count) '**下一個範圍
  2.   If i = 8 Then Set Rng = Rng.Cells(1).Resize(, Rng.Columns.Count - 1)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 脾氣嘴巴不好,心地再好也不能算是好人。
返回列表 上一主題