excel vba判斷顏色取值範圍設定問題

tryit244178

首先加入這2個副程式

1. Private Sub CopyTransparentCell(ByVal seachRange As String)
   
2.     Dim i As Range
   
3.     Dim offestColumn As Integer
   
4.     Const Transparent As Long = 16777215
   
5.    
   
6.     For Each i In Sheet1.Range(seachRange)
   
7.         If i.Interior.Color = Transparent Then
   
8.             offestColumn = i.column - 1
   
9.             Sheet2.Cells(GetLastRow(offestColumn), offestColumn).value = Sheet1.Range("A" & i.Row).value
   
10.         End If
    
11.     Next i
    
12. End Sub
    
13. 
    
14. Private Function GetLastRow(ByVal column As Integer) As Integer
    
15.     GetLastRow = Sheet2.Cells(Sheet2.Cells.Rows.Count, column).End(xlUp).Row + 1
    
16. End Function

複製代碼

然後在按鈕裡加入這行

1.     CopyTransparentCell "B2:C13"

複製代碼

...

瀏覽完整內容，請先 註冊 或 登入會員

tryit244178

那就把 If i.Interior.Color = Transparent Then 這行換成你的格式化條件

假如你的條件是儲存格內的值等於0，就改成
If Not i.Value = 0 Then

應該也能達到同樣的效果
記得把 Const Transparent As Long = 16777215 刪掉

tryit244178

再加入這個函式

1. Private Function ComparisonData(ByVal value As String, ByVal comparisonRange As String) As Boolean
   
2.     Dim i As Range
   
3.    
   
4.     ComparisonData = True
   
5.    
   
6.     For Each i In Sheet1.Range(comparisonRange)
   
7.         If value = i.value Then
   
8.             ComparisonData = False
   
9.             Exit For
   
10.         End If
    
11.     Next i
    
12. End Function

複製代碼

然後把 If i.Interior.Color = Transparent Then
換成 If ComparisonData(i.value, "K2:V23") Then

Const Transparent As Long = 16777215 記得刪掉

---

我發現你是把 CopyTransparentCell "C2:J26" 放在 ex() 裡面
其實可以不用ex()，而直接使用。因為這些程序並不是修改ex()用的
...

瀏覽完整內容，請先 註冊 或 登入會員

tryit244178

用這個試試

---

順便說明一下
offestColumn = i.column - 1
這個是你要貼到 工作表2 的位置
減 1 的話，就是貼到 A 欄；減 0 就是 B 欄；加 1 就是 C 欄…以此類推
...

瀏覽完整內容，請先 註冊 或 登入會員

tryit244178

最新的程序其實做得就是你說的那些事。(一開始是判斷顏色就是)

從你的描述來看，代表比對出來結果，全被判斷為不同
你貼出來的圖裡，比對區放的值都是數字
登錄區裡放的也是數字嗎？
還是有什麼特殊條件，才會造成放到比對區裡的數字？

還有，你登錄區的資料是放在哪個工作表？
...

瀏覽完整內容，請先 註冊 或 登入會員

tryit244178

因為一次清除了很多儲存格
但轉大寫的函式，一次只能轉一個儲存格，所以會產生錯誤
把最上面的程序改為

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim i As Range
   
3.    
   
4.     Application.EnableEvents = False
   
5.     For Each i In Target
   
6.         If Not i = "" Then
   
7.             i = UCase(i)
   
8.         End If
   
9.     Next i
   
10.     Application.EnableEvents = True
    
11. End Sub

複製代碼

---

UCase() 是小寫轉大寫的函式

下載: 訪客無法瀏覽下載點，請先 註冊 或 登入會員

---

最後這段程序…看起來似乎是點到第24行的時候會跳到下一欄的第2行
大概是懶得換行吧XD

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Row = 24 Then Cells(2, Target.column + 1).Select  '懶得換行
   
3. End Sub

複製代碼

你可以像這樣為程序註解，『'』(冒號右邊那顆鍵)
...

瀏覽完整內容，請先 註冊 或 登入會員