麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 關於選取儲存格後，該列範圍變色，出現位移。 [打印本頁]

作者: av8d 時間: 2021-9-3 21:11 標題: 關於選取儲存格後，該列範圍變色，出現位移。

各位前輩們好，
這原是由整列變色改寫而成，但沒改成功，網路上還在努力搜尋中，
錯誤的部分是：
當我選取C4時，該是A4:G4變色
則出現位移成A7:G7

當我選取C5時，該是A5:G5變色
則出現位移成A9:G9

當我選取C6時，該是A6:G6變色
則出現位移成A11:G11

在此先求助前輩們，尋求解答！感謝萬分！請下載附件。
[attach]33973[/attach]

作者: samwang 時間: 2021-9-4 09:20

本帖最後由 samwang 於 2021-9-4 09:23 編輯

回復 1# av8d

請測試看看，謝謝

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xA As Range, xR As Range
Cells.Interior.Pattern = 0
If Target.Column = 3 Then
Set xA = [A4:G1000]
If Intersect(xA, Target) Is Nothing Then Exit Sub
For Each xR In xA.Rows
If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = RGB(240, 255, 240)
Next
End If
End Sub

作者: av8d 時間: 2021-9-4 12:48

回復 2# samwang

感謝前輩大大假日抽空完成了我的煩惱，真的是很厲害，謝謝您！

作者: av8d 時間: 2021-9-5 01:22

回復 2# samwang

不好意思，想再請教前輩大大，
如果是空白，改為單一儲存格變色，該如何改寫？謝謝。

作者: samwang 時間: 2021-9-5 07:14

回復 samwang

不好意思，想再請教前輩大大，
如果是空白，改為單一儲存格變色，該如何改寫？謝謝。
av8d 發表於 2021-9-5 01:22

請測試看看，謝謝
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xA As Range, xR As Range
Set xA = [A1:XFD65536] '設定範圍
If Intersect(xA, Target) Is Nothing Then Exit Sub
xA.Interior.ColorIndex = 0
Intersect(Target, xA).Interior.Color = RGB(255, 255, 0)
End Sub

作者: av8d 時間: 2021-9-5 20:36

回復 5# samwang

謝謝前輩假日抽空協助，我意思是既有的情況(儲存格有則範圍列變色，無則單一儲存格變色)
我修改了前輩的程式碼後為
If Intersect(xA, Target) Is Nothing Then
xA.Interior.ColorIndex = 0
Intersect(Target, xA).Interior.Color = RGB(240, 255, 240)
Else
For Each xR In xA.Rows
If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = RGB(240, 255, 240)
Next
End If
但是功能還是只有範圍變色，沒有單一儲存格變色，受益良多，謝謝前輩。

作者: quickfixer 時間: 2021-9-5 20:56

本帖最後由 quickfixer 於 2021-9-5 20:57 編輯

回復 6# av8d

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xA As Range, xR As Range
Cells.Interior.Pattern = 0
If Target.Column = 3 Then
Set xA = [A4:G1000]
If Intersect(xA, Target) Is Nothing Then Exit Sub
For Each xR In xA.Rows
      If Not Intersect(xR, Target) Is Nothing Then
         If Cells(xR.Row, 3) <> "" Then
            xR.Interior.Color = RGB(240, 255, 240)
         Else
            Cells(xR.Row, 3).Interior.Color = RGB(200, 200, 240)
         End If
      End If
Next
End If
End Sub

作者: samwang 時間: 2021-9-5 21:04

回復 6# av8d

不好意思，可否說明詳細一點或實際範例，謝謝

作者: av8d 時間: 2021-9-6 00:10

本帖最後由 av8d 於 2021-9-6 00:12 編輯

回復 7# quickfixer
回復 8# samwang

謝謝前輩們，我把我改寫後的檔案上傳，請過目。
[attach]33983[/attach]

改寫後操作方式
當點C4時，A4:G4變色，正確。
當點C5時，A5:G5變色，正確。
當點C6時，C6單一格變色，正確。
到這裡原以為改寫完成，都正確了，但是後續操作發現↓

當點C5並刪除後，點C6則會變成A6:G6變色，錯誤，應為C6單一格變色。
再點回C5，A5:G5變色，錯誤，應為C5單一格變色。(因為C5剛已刪除，所以是空白的狀態)

可能我改寫錯了，還請前輩們更正，感激不盡。

作者: quickfixer 時間: 2021-9-6 00:51

本帖最後由 quickfixer 於 2021-9-6 01:05 編輯

回復 9# av8d

我使用samwang的程式碼,在#7改寫的,用你的說明操作,沒問題

要刪除後立刻變色,在#7多加入下面3行
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then Call Worksheet_SelectionChange(Target)
End Sub

作者: av8d 時間: 2021-9-6 01:48

本帖最後由 av8d 於 2021-9-6 01:52 編輯

回復 10# quickfixer

謝謝前輩，都凌晨1點了，前輩不辭辛勞，真是很感謝您。
可以使用，沒問題，受益良多，學習了許多未曾知道的知識領域。

作者: av8d 時間: 2021-9-9 01:41

回復 10# quickfixer

前輩您好，這時提問您可能睡了，等您有空再研究，
我尋找了許久，不知是否有這功能。

計畫透過ComboBox1_Change去調整被選取時的顏色變更，有使用Public公開讓兩邊都能使用，
文字敘述可能不夠詳細，附上附件，請前輩過目，謝謝！

[attach]33994[/attach]

作者: samwang 時間: 2021-9-9 07:41

回復 12# av8d

如附件請測試看看，謝謝。

作者: av8d 時間: 2021-9-9 14:40

回復 13# samwang

謝謝前輩抽空解惑，原來是使用模組的方式，受益良多，謝謝您不遠千里的幫助。

作者: samwang 時間: 2021-9-9 15:18

回復 14# av8d

不好意思，更新一下您原來的程式碼的一些地方如下紅字，不知是否更符合您需求? 請測試看看，謝謝

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xA As Range, xR As Range
Call 顏色
Set xA = [A4:G1000]
If Target.Column = 3 Then
'Set xA = [A4:G1000]
xA.Interior.Pattern = 0
If Intersect(xA, Target) Is Nothing Then Exit Sub
For Each xR In xA.Rows
      If Not Intersect(xR, Target) Is Nothing Then
         If Cells(xR.Row, 3) <> "" Then
            xR.Interior.Color = GBY
         Else
            Cells(xR.Row, 3).Interior.Color = GBY
         End If
      End If
Next
Else
xA.Interior.Pattern = 0
End If
End Sub

作者: quickfixer 時間: 2021-9-9 15:36

回復 14# av8d

不是的,跟模組無關,是你搞錯了
Public Sub,Private Sub不是拿來傳變數
samwang有幫你修正程式了,只是把一部份搬到模組

你#12的檔案,不用模組,改2行就正確了
第一行在 ComboBox1_Change()上面,加上
Public GBY
第二行刪掉Worksheet_SelectionChange重覆定義的gby
刪掉這個GBY As Variant

作者: av8d 時間: 2021-9-29 20:00

本帖最後由 av8d 於 2021-9-29 20:03 編輯

回復 15# samwang
回復 16# quickfixer

受益良多，前輩後來我改寫後沒問題，請問能否在添加文字時，也該格添加顏色？
目前我只能做到這程度但是比較希望在打開後能一目了然，網上查了許久，都沒找到。
[attach]34089[/attach]

前輩大概的意思大概是在這裡加入各別的背景顏色的意思

Private Sub Workbook_Open()
With Sheets("我的知識庫").ComboBox1
.AddItem "綠"
.AddItem "藍"
.AddItem "黃"
End With
End Sub

複製代碼

作者: samwang 時間: 2021-9-30 08:14

回復 17# av8d

功能正常，不知道您的問題在哪裡? 謝謝

作者: av8d 時間: 2021-9-30 11:18

回復 18# samwang

感謝前輩抽空觀看，我想詢問一下。
除了能預先將文字添加外，能否在各文字背景也添加顏色？
還是說沒有這功能，我目前查詢結果只有在UserForm上才能做。

作者: samwang 時間: 2021-9-30 11:20

回復 17# av8d

請問能否在添加文字時，也該格添加顏色？
>> 該格添加顏色這個在13#應該就是你要的，另外用你提供的檔案已修改完成如附件，請確認是否您的需求，謝謝

作者: av8d 時間: 2021-9-30 15:10

本帖最後由 av8d 於 2021-9-30 15:25 編輯

回復 20# samwang

效果像這樣，但不用UserFrom做

不能網底變色，單一文字變色也是我的目標，謝謝前輩大力協助，我會自己努力繼續查找的，跟您學了很多。受益良多。

作者: samwang 時間: 2021-9-30 16:51

回復 21# av8d

不能網底變色，單一文字變色也是我的目標，
>> 您的需求是字體改顏色，不是儲存格加顏色(底色)，不知我的理解是否正確，謝謝。

作者: av8d 時間: 2021-9-30 21:42

回復 22# samwang

前輩大大您好，其實有方法都可以，
因為這樣比較方便使用者快速選到想要的選項，不過好像都只有UserForm能指定的樣子。

作者: av8d 時間: 2021-10-1 19:08

回復 22# samwang

samwang前輩您好，想請教您
If Intersect(xA, Target) Is Nothing Then Exit Sub
這段的意思是？
我最近寫到兩個區塊，

If Target.Column = 3 Then
Call 顏色
Set xC = [C1]
xC.Interior.Pattern = 0
If Intersect(xC, Target) Is Nothing Then Exit Sub
For Each xR In xC.Rows
If Not Intersect(xR, Target) Is Nothing Then
If Cells(xR.Row, 3) <> "" Then
Cells(xR.Row, 3).Interior.Color = Col
Else
Cells(xR.Row, 3).Interior.Color = Col
End If
End If
Next
Set xAH = [A4:H1000]
xAH.Interior.Pattern = 0
If Intersect(xAH, Target) Is Nothing Then Exit Sub
For Each xR In xAH.Rows
If Not Intersect(xR, Target) Is Nothing Then
If Cells(xR.Row, 3) <> "" Then
[F2] = ActiveCell
[G2] = ActiveCell
xR.Interior.Color = Col
Else
[F2] = ActiveCell
[G2] = ActiveCell
Cells(xR.Row, 3).Interior.Color = Col
End If
End If
Next

複製代碼

在除錯的時候將If Intersect(xA, Target) Is Nothing Then Exit Sub拿掉即可使用，
但是想知道為什麼？萬分感謝。

作者: samwang 時間: 2021-10-1 22:01

回復 24# av8d

If Intersect(xA, Target) Is Nothing Then Exit Sub
這段的意思是？
>> 可以利用F1查詢，Intersect: 會傳回代表兩個或多個範圍的矩形交集的 Range 物件。如果指定的一個或多個範圍來自不同的工作表，則會傳回錯誤。
所以如過選擇是Target:3 col但沒有在xA範圍就離開

作者: av8d 時間: 2021-10-2 01:31

本帖最後由 av8d 於 2021-10-2 01:58 編輯

回復 25# samwang

萬分感謝，請問前輩開啟VBA這段程式碼突然失效

Private Sub Workbook_Open()
Application.VBE.MainWindow.Visible = True
End Sub

複製代碼

原本正常(如下圖)
[attach]34109[/attach]

後來不知什麼原因失效(如下圖)
[attach]34110[/attach]

不知前輩有沒有遇到過，如果有還請解惑，萬分感謝。

作者: av8d 時間: 2021-10-2 07:55

回復 samwang

萬分感謝，請問前輩開啟VBA這段程式碼突然失效原本正常(如下圖)

後來不知什麼原因 ...
av8d 發表於 2021-10-2 01:31

後來發現，是因為有自訂表單，所以會失效，但是又不能因此移除自訂表單，繼續尋找答案中。
備註：自訂表單=UserForm

作者: av8d 時間: 2021-10-8 01:00

回復 25# samwang

有一個標題延伸的問題想請教，如附件
[attach]34177[/attach]

檔案中ComboBox1_Change透過改寫可正常變色，

Public Sub ComboBox1_Change()
Call 顏色
ComboBox1.BackColor = GBY
Dim myRng As Range
Set myRng = ActiveCell
[A1].Select
myRng.Select
End Sub

複製代碼

原先沒有[A1].Select，為了觸發變色，但是不知道該如何改寫，只好為了有對的結果加入的，
請問前輩，是否更好的寫法讓在ComboBox1變動時，原變色的儲存格或列變色呢？謝謝

作者: samwang 時間: 2021-10-8 09:29

回復 28# av8d

是否更好的寫法讓在ComboBox1變動時，原變色的儲存格或列變色呢？
>>不好意思，終於了解您的需求，如附件請測試看看，謝謝

作者: av8d 時間: 2021-10-8 10:08

回復 29# samwang

Worksheet_SelectionChange改成模組的寫法我很喜歡，進而學習到更多新知，謝謝您！

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