返回列表 上一主題 發帖

區域內顯示輸入值填滿顏色之問題

區域內顯示輸入值填滿顏色之問題

問題1:全部(列2-列18),當輸入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿黃色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:限制區間(例如:列10-列18),當輸入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿黃色顯示,並在個數統計欄,在各順序下方統計出個數。

問題40-標示.rar (9.09 KB)

希望支持!

http://blog.xuite.net/hcm19522/twblog/356570552

TOP

附檔有修正,我的問題雖然有二,但輸入資料只有一列
,當輸入列範圍不同時,才會更動,並按不同顏色顯示。

問題1:全部(列2-列18),當輸入搜尋範圍(2-18),表示搜尋b2至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:全部(列10-列18),當輸入搜尋範圍(10-18),表示搜尋b10至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題40-標示.rar (9.47 KB)

希望支持!

TOP

回復 1# s7659109


    這樣有符合你的需求嗎?
  1. Sub check_it()
  2. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
  3. Sheets("工作表1").Range("g21:l21").Clear
  4. For i = 7 To 12
  5.     For Each mrng In Sheets("工作表1").Range("B2:x18")
  6.      If mrng.Value = Cells(20, i) Then
  7.       mrng.Interior.ColorIndex = 6
  8.       Cells(20, i).Offset(1, 0) = Cells(20, i).Offset(1, 0).Value + 1
  9.      End If
  10.     Next
  11. Next
  12. End Sub

  13. Sub check_it2()
  14. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
  15. Sheets("工作表1").Range("G23:L23").Clear
  16. RngA = Left([c22], Application.Find("-", [c22]) - 1)
  17. RngB = Right([c22], Len([c22]) - (Application.Find("-", [c22])))
  18. For x = 7 To 12
  19.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
  20.      If mrng.Value = Cells(22, x) Then
  21.       mrng.Interior.ColorIndex = 6
  22.       Cells(22, x).Offset(1, 0) = Cells(22, x).Offset(1, 0).Value + 1
  23.      End If
  24.     Next
  25. Next
  26. End Sub
複製代碼

TOP

套用程式碼,仍有誤,問題已修正如下
問題1:全部(列2-列18),當輸入搜尋範圍(2-18),表示搜尋b2至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:全部(列10-列18),當輸入搜尋範圍(10-18),表示搜尋b10至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題40-1-標示.rar (10.05 KB)

希望支持!

TOP

回復 6# s7659109


    這樣子呢?
  1. Sub check_it()
  2. Range("B2:x18").Interior.ColorIndex = 0
  3. Range("G21:L21").Clear
  4. RngA = Left([c20], Application.Find("-", [c20]) - 1)
  5. RngB = Right([c20], Len([c20]) - (Application.Find("-", [c20])))
  6. For x = 7 To 12
  7.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
  8.      If mrng.Value = Cells(20, x) Then
  9.       mrng.Interior.ColorIndex = 6
  10.       Cells(20, x).Offset(1, 0) = Cells(20, x).Offset(1, 0).Value + 1
  11.      End If
  12.     Next
  13.   If Cells(21, x) = "" Then Cells(21, x).Value = 0
  14. Next
  15. End Sub
複製代碼

TOP

G21:
=COUNTIF(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")),G20)

B2.格式化條件:
條件1:=(B2=$G$20)*MODE(ROW(),ROW(INDIRECT(SUBSTITUTE($C$20,"-",":")))) 黃底色
條件2∼6,自行去設∼∼
(我的版本只能設3個)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

程式碼部分,是可以,但只顯示黃色,可否按順序1~6分成不同顏色顯示,另外每修改1次
都要到程式碼中,重新執行1次,才能更新,是否還有其他方式,更改時,就可直接更動。
(儲存為.xlsm)
希望支持!

TOP

本帖最後由 owen06 於 2015-11-13 17:23 編輯

回復 9# s7659109

像這樣?
另外你的b2:x18似乎因為儲存格有設定格式化條件的關係,所以有些資料跑出來的顏色會錯亂,把格式化條件清掉才會正常
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. With Target
  3.    If .Row = 20 And .Column >= 7 And .Column <= 12 Then
  4.     RngA = Left([C20], Application.Find("-", [C20]) - 1)
  5.     RngB = Right([C20], Len([C20]) - (Application.Find("-", [C20])))
  6.     Ans = .Value
  7. On Error GoTo 99
  8.    If Application.CountA([G20:L20]) = 0 Then GoTo 99
  9.    If .Value = "" Then .Offset(1, 0) = ""
  10.    
  11.      For Each Mrng In Range("B" & RngA & ":x" & RngB)
  12.        If Mrng.Value = Ans Then
  13.         Mrng.Interior.ColorIndex = .Offset(-1, 0).Interior.ColorIndex
  14.         .Offset(1, 0) = .Offset(1, 0).Value + 1
  15.        End If
  16.      Next
  17.    End If
  18. End With
  19. Exit Sub

  20. 99: Range("b2:x18").Interior.ColorIndex = 0: Range("G21:L21") = ""
  21. End Sub
複製代碼

TOP

拜讀 "准大" ,G20:L20不重複且防止整列相同
G20:L20{=INDIRECT(TEXT(RIGHT(MIN(IF(COUNTIF($F20:F20,INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))=0, COLUMN(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))+ROW(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))*100)),4),"!R0C00"),)

TOP

        靜思自在 : 要比誰更受誰.不要比誰更怕誰。
返回列表 上一主題