找回密碼 或 安全提問
 註冊
|註冊|登錄

伊莉討論區

搜索
感激所有對伊莉作出奉獻的人尊貴會員無限看帖不用回覆認識好友、聊天,分享生活趣事
波多野結fc2鬼父中文3d幼女惡靈古堡
袁子儀mkmp 548kfebwh 074same 079[ショー海賊王女

休閒聊天興趣交流學術文化旅遊交流飲食交流家庭事務PC GAMETV GAME
熱門線上其他線上感情感性寵物交流家族門派動漫交流貼圖分享BL/GL
音樂世界影視娛樂女性頻道潮流資訊BT下載區GB下載區下載分享短片
電腦資訊數碼產品手機交流交易廣場網站事務長篇小說體育運動時事經濟
上班一族博彩娛樂

[繁]肌肉魔法使-MASHL

[繁]超龍珠英雄MM 02-

TVアニメ『一拳超人

[繁]葬送的芙莉蓮25-

[繁]因為不是真正的夥

[繁]月光下的異世界之
C & C++ 語言C# 語言Visual Basic 語言PHP 語言JAVA 語言
查看: 5293|回復: 13

[求助] excel vba判斷顏色取值範圍設定問題[複製鏈接]

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-7 01:41 PM|顯示全部樓層
所有積分大於負-100的壞孩子,將可獲得重新機會成為懲罰生,權限跟幼兒生一樣。

如上圖所示,資料在工作表1中,
想在工作表2中回傳工作表1未變色的數值的名字部分,
如工作表2的內容,
網路上搜尋的語法下,
  1. Option Explicit
  2. Sub ex()
  3.     Dim A As Range, A_Po As String
  4.     Dim AA As Range, Sh As Worksheet
  5.    
  6.     'FindFormat 屬性 設定或傳回要尋找之儲存格格式類型的搜尋準則。
  7.     With Application.FindFormat
  8.         .Clear                      '清除以前的設定
  9.        ' .Interior.Color = vbred    '設定儲存格圖樣顏色(紅色)
  10.         .Interior.ColorIndex = 3   '設定儲存格圖樣顏色(紅色
  11.     End With
  12.     Set Sh = 工作表1
  13.     Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells(1).Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
  14.     Do While Not A Is Nothing
  15.         If A_Po = "" Then
  16.             A_Po = A.Address
  17.             Set AA = A
  18.         End If
  19.         Set AA = Union(AA, A)
  20.         Set A = Sh.Cells.Find(What:="", AFTER:=A, SearchFormat:=True) '下一個相同格式搜尋
  21.         If A_Po = A.Address Then Exit Do
  22.     Loop
  23.     If Not A Is Nothing Then AA.Copy Sheets("工作表2").Range("A2")
  24. End Sub
複製代碼
其中set sh部分設定是在工作表1中,
但我想在工作表2中分項找出未變黑的資料所對應的名字,
因此我試著在set sh=工作表1中加入範圍,如range("a2:a13"),
但都無法運作,因此向請問版上高手範圍的部分該在哪加入呢?
另外,工作表1中可能有七、八項資料,都需回傳到工作表2中,
有什麼寫法可以更精簡呢?還是就貼上七、八次就好了,
謝謝大家!
備註:語法中是紅色,圖示是黑色,是我忘了改,並非因此緣故而導致問題產生。
...
瀏覽完整內容,請先 註冊登入會員
附件: 你需要登錄才可以下載或查看附件。沒有帳號?註冊

點評

tryit244178 這似乎不是你需要的功能  發表於 2017-2-8 07:14 AM
回覆中加入附件並不會使你增加積分,請使用主題方式發佈附件。

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-8 06:12 AM|顯示全部樓層
成為伊莉的版主,你將獲得更高級和無限的權限。把你感興趣的版面一步步地發展和豐盛,那種滿足感等著你來嚐嚐喔。
本帖最後由 tryit244178 於 2017-2-8 10:22 AM 編輯

首先加入這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. Private Function GetLastRow(ByVal column As Integer) As Integer
  14.     GetLastRow = Sheet2.Cells(Sheet2.Cells.Rows.Count, column).End(xlUp).Row + 1
  15. End Function
複製代碼

然後在按鈕裡加入這行
  1.     CopyTransparentCell "B2:C13"
複製代碼
...
瀏覽完整內容,請先 註冊登入會員

點評

tryit244178 有個變數名字打錯了,已修正  發表於 2017-2-8 09:40 AM
若新密碼無法使用,可能是數據未更新。請使用舊密碼看看。

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-8 03:13 PM|顯示全部樓層
所有積分大於負-100的壞孩子,將可獲得重新機會成為懲罰生,權限跟幼兒生一樣。
tryit244178 發表於 2017-2-8 06:12 AM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

首先加入這2個副程式
然後在按鈕裡加入這行

請問一下,
格字內黑色的填滿是我運用格式化條件而達成的,
...
瀏覽完整內容,請先 註冊登入會員

點評

tryit244178 沒錯  發表於 2017-2-11 06:04 AM
如果發覺自己無法使用一些功能或出現問題,請按重新整理一次,並待所有網頁內容完全載入後5秒才進行操作。

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-8 04:00 PM|顯示全部樓層
若有安裝色情守門員,可用無界、自由門等軟件瀏覽伊莉。或使用以下網址瀏覽伊莉: http://www.eyny.com:81/index.php
本帖最後由 tryit244178 於 2017-2-11 04:18 AM 編輯

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

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

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

點評

tryit244178 這邊改成比對數值  發表於 2017-2-11 06:04 AM
若瀏覽伊莉的時侯發生問題或不正常情況,請使用Internet Explorer(I.E)。

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-9 01:53 AM|顯示全部樓層
分享使你變得更實在,可以使其他人感到快樂,分享是我們的動力。今天就來分享你的資訊、圖片或檔案吧。
本帖最後由 zbc231 於 2017-2-9 07:36 AM 編輯
tryit244178 發表於 2017-2-8 04:00 PM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

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

假如你的條件是儲存格內的值等於 ...
...
瀏覽完整內容,請先 註冊登入會員





點評

tryit244178 講錯,你設自動上色的條件是什麼?  發表於 2017-2-9 02:57 AM
tryit244178 你C2裡寫的條件是什麼?  發表於 2017-2-9 02:49 AM

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-9 07:36 AM|顯示全部樓層
若瀏覽伊莉的時侯發生問題或不正常情況,請使用Internet Explorer(I.E)。
zbc231 發表於 2017-2-9 01:53 AM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

目前的寫法為當初sheet1中格式化條件的寫法如下,
=COUNTIF(登錄區,C2),
countif 不是VBA函數,而是excel ...

補充:
...
瀏覽完整內容,請先 註冊登入會員
如果瀏覽伊莉時速度太慢或無法連接,可以使用其他分流瀏覽伊莉,www01.eyny.com(02,03)。

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-9 10:02 AM|顯示全部樓層
本帖最後由 tryit244178 於 2017-2-11 04:18 AM 編輯

再加入這個函式
  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()用的
...
瀏覽完整內容,請先 註冊登入會員
分享使你變得更實在,可以使其他人感到快樂,分享是我們的動力。今天就來分享你的資訊、圖片或檔案吧。

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-10 02:22 AM|顯示全部樓層
成為伊莉的版主,你將獲得更高級和無限的權限。把你感興趣的版面一步步地發展和豐盛,那種滿足感等著你來嚐嚐喔。
tryit244178 發表於 2017-2-9 10:02 AM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

再加入這個函式
然後把 If i.Interior.Color = Transparent Then
換成 If ComparisonData(i.value, "K2:V23 ...
  1. Option Explicit
  2. Private Function ComparisonData(ByVal value As String, ByVal comparisonRange As String) As Boolean
  3.     Dim i As Range
  4.     ComparisonData = True
  5.     For Each i In Sheet1.Range(comparisonRange)
  6.         If value = i.value Then
  7.             ComparisonData = False
  8.             Exit For
  9.         End If
  10.     Next i
  11. End Function
  12. Private Sub CopyTransparentCell(ByVal seachRange As String)
  13.     Dim i As Range
  14.     Dim offestColumn As Integer
  15.     For Each i In Sheet1.Range(seachRange)
  16.       If ComparisonData(i.value, "K2:V23") Then
  17.             offestColumn = i.column - 2
  18.             工作表1.Cells(GetLastRow(offestColumn), offestColumn).value = Sheet1.Range("B" & i.Row).value
  19.         End If
  20.     Next i
  21. End Sub
  22. Private Function GetLastRow(ByVal column As Integer) As Integer
  23.     GetLastRow = 工作表1.Cells(工作表1.Cells.Rows.Count, column).End(xlUp).Row + 1
  24. End Function
  25. Sub ex()
  26.     Dim A As Range, A_Po As String
  27.     Dim AA As Range, Sh As Worksheet
  28.     With Application.FindFormat
  29.         .Clear
  30.         .Interior.Color = vbBlack    '設定儲存格圖樣顏色
  31.         .Interior.ColorIndex = 1   '設定儲存格圖樣顏色
  32.     End With
  33.     Set Sh = Sheet1
  34.     Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells(1).Count), SearchFormat:=True)
  35.     Do While Not A Is Nothing
  36.         If A_Po = "" Then
  37.             A_Po = A.Address
  38.             Set AA = A
  39.         End If
  40.         Set AA = Union(AA, A)
  41.         Set A = Sh.Cells.Find(What:="", AFTER:=A, SearchFormat:=True)
  42.         If A_Po = A.Address Then Exit Do
  43.     Loop
  44.    CopyTransparentCell "C2:J26"
  45. End Sub
複製代碼
目前的寫法修正如下,
但似乎還是無法達成,
現在連手動將格子填滿還是會抓到全部的資料,
不像之前還能挑出。
是上述的程式順序要更換嗎?
另外,
  1.   CopyTransparentCell "C2:J26"
複製代碼
是要放在哪裡呢?
如果放在最後的話,
excel會出現編譯錯誤,只有註解可以放在endsub.end function.或end property後面,
所以我才會放在ex()裡面,
還是我放錯位置導致無法順利執行?
以上兩個問題再麻煩你了。...
瀏覽完整內容,請先 註冊登入會員
若有安裝色情守門員,可用無界、自由門等軟件瀏覽伊莉。或使用以下網址瀏覽伊莉: http://www.eyny.com:81/index.php

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-10 03:30 AM|顯示全部樓層
本帖最後由 tryit244178 於 2017-2-11 04:18 AM 編輯

用這個試試
順便說明一下
offestColumn = i.column - 1
這個是你要貼到 工作表2 的位置
減 1 的話,就是貼到 A 欄;減 0 就是 B 欄;加 1 就是 C 欄…以此類推
...
瀏覽完整內容,請先 註冊登入會員

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-10 06:25 AM|顯示全部樓層
本帖最後由 zbc231 於 2017-2-10 06:34 AM 編輯
tryit244178 發表於 2017-2-10 03:30 AM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

用這個試試
順便說明一下
offestColumn = i.column - 1
這個是你要貼到 工作表2 的位置[/ba ...
...
瀏覽完整內容,請先 註冊登入會員





點評

tryit244178 噢!沒事,減2才對,自已寫的程式碼,自已忘記了XD  發表於 2017-2-10 06:47 AM
tryit244178 offestColumn = i.column - 1 是指貼到工作表2的欄位,不是工作表1。減2就貼過頭了,最多只能減1  發表於 2017-2-10 06:46 AM
tryit244178 姓名前面有編號的話,改成這個 工作表2.Cells(GetLastRow(offestColumn), offestColumn).value = 工作表1.Range("B" & i.Row).value  發表於 2017-2-10 06:37 AM
tryit244178 原來如此,因為怕位置不一樣,所以才特地說明  發表於 2017-2-10 06:33 AM

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-10 06:10 PM|顯示全部樓層
成為伊莉的版主,你將獲得更高級和無限的權限。把你感興趣的版面一步步地發展和豐盛,那種滿足感等著你來嚐嚐喔。
本帖最後由 tryit244178 於 2017-2-11 04:19 AM 編輯

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

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

還有,你登錄區的資料是放在哪個工作表?
...
瀏覽完整內容,請先 註冊登入會員
若瀏覽伊莉的時侯發生問題或不正常情況,請使用Internet Explorer(I.E)。

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-11 03:21 AM|顯示全部樓層
分享使你變得更實在,可以使其他人感到快樂,分享是我們的動力。今天就來分享你的資訊、圖片或檔案吧。
tryit244178 發表於 2017-2-10 06:10 PM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

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

從你的描述來看,代表比對出來結果,全被判 ...
...
瀏覽完整內容,請先 註冊登入會員

點評

tryit244178 太好了,這樣就可以用變色的自動化條件了  發表於 2017-2-11 05:28 AM
回覆中加入附件並不會使你增加積分,請使用主題方式發佈附件。

使用道具檢舉

Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6Rank: 6

帖子
155
積分
1291 點
潛水值
47805 米
發表於 2017-2-11 04:09 AM|顯示全部樓層
若對尊貴或贊助會員有任何疑問,歡迎向我們查詢。我們的即時通或MSN: admin@eyny.com
本帖最後由 tryit244178 於 2017-2-11 06:36 AM 編輯

因為一次清除了很多儲存格
但轉大寫的函式,一次只能轉一個儲存格,所以會產生錯誤
把最上面的程序改為
  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
複製代碼

你可以像這樣為程序註解,『'』(冒號右邊那顆鍵)
...
瀏覽完整內容,請先 註冊登入會員
如果瀏覽伊莉時速度太慢或無法連接,可以使用其他分流瀏覽伊莉,www01.eyny.com(02,03)。

使用道具檢舉

Rank: 1

帖子
66
積分
91 點
潛水值
17057 米
發表於 2017-2-11 07:04 AM|顯示全部樓層
若新密碼無法使用,可能是數據未更新。請使用舊密碼看看。
tryit244178 發表於 2017-2-11 04:09 AM
下載: 訪客無法瀏覽下載點,請先 註冊登入會員

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

...
瀏覽完整內容,請先 註冊登入會員

點評

tryit244178 ლ(◉◞౪◟◉ )ლ   發表於 2017-2-11 07:49 AM

使用道具檢舉

您需要登錄後才可以回帖 登錄 | 註冊

Powered by Discuz!

© Comsenz Inc.

重要聲明:本討論區是以即時上載留言的方式運作,對所有留言的真實性、完整性及立場等,不負任何法律責任。而一切留言之言論只代表留言者個人意見,並非本網站之立場,用戶不應信賴內容,並應自行判斷內容之真實性。於有關情形下,用戶應尋求專業意見(如涉及醫療、法律或投資等問題)。 由於本討論區受到「即時上載留言」運作方式所規限,故不能完全監察所有留言,若讀者發現有留言出現問題,請聯絡我們。有權刪除任何留言及拒絕任何人士上載留言,同時亦有不刪除留言的權利。切勿上傳和撰寫 侵犯版權(未經授權)、粗言穢語、誹謗、渲染色情暴力或人身攻擊的言論,敬請自律。本網站保留一切法律權利。
回頂部