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

帖子: 248
主題: 76
精華: 0
積分: 331
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 男
來自: kaohsiung
註冊時間: 2013-6-10
最後登錄: 2020-7-3

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-11-13 09:52 | 只看該作者

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

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

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

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

樓主熱帖

希望支持!

hcm19522

大學生 Rank: 4

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-27

熱烈參與勳章

2^#

發表於 2015-11-13 12:55 | 只看該作者

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

帖子: 248
主題: 76
精華: 0
積分: 331
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 男
來自: kaohsiung
註冊時間: 2013-6-10
最後登錄: 2020-7-3

3^#

發表於 2015-11-13 13:43 | 只看該作者

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

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

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

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

希望支持!

owen06

　暱稱: 阿軒

帖子: 396
主題: 12
精華: 0
積分: 425
點名: 1
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2013-7-2
最後登錄: 2024-8-23

2015羊年全勤獎章 2014馬年全勤獎章熱烈參與勳章

4^#

發表於 2015-11-13 13:59 | 只看該作者

回復 1# s7659109

這樣有符合你的需求嗎？

Sub check_it()
Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
Sheets("工作表1").Range("g21:l21").Clear
For i = 7 To 12
For Each mrng In Sheets("工作表1").Range("B2:x18")
If mrng.Value = Cells(20, i) Then
mrng.Interior.ColorIndex = 6
Cells(20, i).Offset(1, 0) = Cells(20, i).Offset(1, 0).Value + 1
End If
Next
Next
End Sub
Sub check_it2()
Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
Sheets("工作表1").Range("G23:L23").Clear
RngA = Left([c22], Application.Find("-", [c22]) - 1)
RngB = Right([c22], Len([c22]) - (Application.Find("-", [c22])))
For x = 7 To 12
For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
If mrng.Value = Cells(22, x) Then
mrng.Interior.ColorIndex = 6
Cells(22, x).Offset(1, 0) = Cells(22, x).Offset(1, 0).Value + 1
End If
Next
Next
End Sub

複製代碼

帖子: 248
主題: 76
精華: 0
積分: 331
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 男
來自: kaohsiung
註冊時間: 2013-6-10
最後登錄: 2020-7-3

5^#

發表於 2015-11-13 14:15 | 只看該作者

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

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

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

希望支持!

owen06

　暱稱: 阿軒

帖子: 396
主題: 12
精華: 0
積分: 425
點名: 1
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2013-7-2
最後登錄: 2024-8-23

2015羊年全勤獎章 2014馬年全勤獎章熱烈參與勳章

6^#

發表於 2015-11-13 14:29 | 只看該作者

回復 6# s7659109

這樣子呢？

Sub check_it()
Range("B2:x18").Interior.ColorIndex = 0
Range("G21:L21").Clear
RngA = Left([c20], Application.Find("-", [c20]) - 1)
RngB = Right([c20], Len([c20]) - (Application.Find("-", [c20])))
For x = 7 To 12
For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
If mrng.Value = Cells(20, x) Then
mrng.Interior.ColorIndex = 6
Cells(20, x).Offset(1, 0) = Cells(20, x).Offset(1, 0).Value + 1
End If
Next
If Cells(21, x) = "" Then Cells(21, x).Value = 0
Next
End Sub

複製代碼

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

7^#

發表於 2015-11-13 14:48 | 只看該作者

Ｇ２１：
=COUNTIF(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")),G20)

Ｂ２．格式化條件：
條件１：=(B2=$G$20)*MODE(ROW(),ROW(INDIRECT(SUBSTITUTE($C$20,"-",":"))))　黃底色
條件２～６，自行去設～～
（我的版本只能設３個）

帖子: 248
主題: 76
精華: 0
積分: 331
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 男
來自: kaohsiung
註冊時間: 2013-6-10
最後登錄: 2020-7-3

8^#

發表於 2015-11-13 15:28 | 只看該作者

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

希望支持!

owen06

　暱稱: 阿軒

帖子: 396
主題: 12
精華: 0
積分: 425
點名: 1
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2013-7-2
最後登錄: 2024-8-23

2015羊年全勤獎章 2014馬年全勤獎章熱烈參與勳章

9^#

發表於 2015-11-13 17:17 | 只看該作者

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

回復 9# s7659109

像這樣？
另外你的b2:x18似乎因為儲存格有設定格式化條件的關係，所以有些資料跑出來的顏色會錯亂，把格式化條件清掉才會正常

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row = 20 And .Column >= 7 And .Column <= 12 Then
RngA = Left([C20], Application.Find("-", [C20]) - 1)
RngB = Right([C20], Len([C20]) - (Application.Find("-", [C20])))
Ans = .Value
On Error GoTo 99
If Application.CountA([G20:L20]) = 0 Then GoTo 99
If .Value = "" Then .Offset(1, 0) = ""
For Each Mrng In Range("B" & RngA & ":x" & RngB)
If Mrng.Value = Ans Then
Mrng.Interior.ColorIndex = .Offset(-1, 0).Interior.ColorIndex
.Offset(1, 0) = .Offset(1, 0).Value + 1
End If
Next
End If
End With
Exit Sub
99: Range("b2:x18").Interior.ColorIndex = 0: Range("G21:L21") = ""
End Sub

複製代碼

hcm19522

大學生 Rank: 4

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-27

熱烈參與勳章

10^#

發表於 2015-11-13 19:25 | 只看該作者

拜讀 "准大" ,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"),)