12
返回列表 上一主題 發帖

[發問] 兩個問題：比對迴圈 & 儲存格閃爍

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
87  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-4-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
6# 跳轉到 »
發表於 2013-11-26 18:34 | 只看該作者
回復 4# GBKEE

謝謝板大的解釋

不過我還是不太清楚該如何指定特定儲存格閃爍
以下是我的做法，是可以閃爍XDD
不過他陣列好像會一直倍數增加@@
  1. Private Sub twinkle()
  2.    
  3.     Dim Rng As Range
  4.     Dim Ar() As Integer
  5.    
  6.     T = Time
  7.     T2 = Time
  8.     Do
  9.         DoEvents
  10.         
  11.         If Time - T > TimeValue("00:00:01") Then
  12.             T = Time
  13.             For i = 6 To Worksheets(2).Range("M65536").End(xlUp).Row
  14.                 If Range("M" & i).Interior.Color = 255 Then
  15.                     Range("M" & i).Interior.ColorIndex = -4142
  16.                     j = j + 1
  17.                     
  18.                     ReDim Preserve Ar(j)
  19.                     
  20.                     Ar(j) = i
  21.                 End If
  22.             Next
  23.             'MsgBox j
  24.             Debug.Print j
  25.             
  26.         End If
  27.         
  28.         'If Time - T > #12:00:05 AM# Then
  29.         
  30.         If Time - T2 > TimeValue("00:00:01") Then
  31.             T2 = Time
  32.             'Application.Wait Now + TimeValue("00:00:01")
  33.             For k = 1 To j
  34.                 Range("M" & Ar(k)).Interior.Color = 255
  35.             Next
  36.             
  37.         End If
  38.         
  39.     Loop
  40.    
  41. End Sub
複製代碼
不知該怎麼修

麻煩大大幫我看看  謝謝  :  )

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2013-11-26 16:50 | 只看該作者
回復 1# li_hsien
參考
  1. Static Sub SetRangeFlashing(Optional Target, Optional ColorIndex, Optional bQuit As Boolean)
  2.   '使用方法:
  3.   '  要開始閃爍請呼叫：SetRangeFlashing Target:=Range("A1:B2,C3"), ColorIndex:=3
  4.   '  要停止閃爍請呼叫：SetRangeFlashing bQuit:=True

  6.   Dim dteNextTime As Date
  7.   Dim bStatus As Boolean
  8.   Dim RecordColor
  9.   Dim rngFlash As Range
  10.   
  11.   If bQuit Then
  12.     rngFlash.Interior.ColorIndex = RecordColor
  13.     Application.OnTime dteNextTime, "SetRangeFlashing", , False
  14.   Else
  15.     If Not IsMissing(Target) Then Set rngFlash = Target
  16.     If Not IsMissing(ColorIndex) Then RecordColor = ColorIndex
  17.    
  18.     rngFlash.Interior.ColorIndex = IIf(bStatus, RecordColor, xlColorIndexNone)
  19.     bStatus = Not bStatus
  20.     dteNextTime = Now + TimeValue("00:00:01")
  21.     Application.OnTime dteNextTime, "SetRangeFlashing"
  22.   End If
  23. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-11-26 15:24 | 只看該作者
回復 3# li_hsien
要有時間的間隔,來改變儲存格的底色,才會造成儲存格閃爍的視覺效果.
DeEvents : 交回控制權回給系統,
只要讓原本是紅色的那幾個閃爍 : 你就指定哪些儲存格
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

li_hsien

帖子
248 
主題
55 
精華
0 
積分
314 
點名
87  
作業系統
XP / WIN7 
軟體版本
2003 / 2007 
閱讀權限
20 
性別
男 
來自
Tainan 
註冊時間
2013-10-18 
最後登錄
2024-4-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇贊助勳章2014馬年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2013-11-26 13:36 | 只看該作者
回復 2# GBKEE

測試了閃爍部分的語法，真的是我想要的執行方式耶

不過我想要閃爍的部分，是只有原來紅色底的儲存格
(紅->無填滿，無填滿->紅，都是同一個儲存格)

因為我表單內有各種顏色，還有無填滿的空白格，我只要讓原本是紅色的那幾個閃爍

想請問板大，如果加入這條件該怎麼寫???


另外我想了解一下
是因為DeEvents的關係，所以能讓程式持續運行且可以執行其他動作嗎???
還想請問 If Time - T > #12:00:01 AM# Then    為什麼是間隔 1秒呀??? 不太懂

感謝大大的幫忙    謝謝   :  )

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-11-26 11:24 | 只看該作者
回復 1# li_hsien
試試看
  1. Option Explicit
  2. Sub ex()
  3.     Dim Ar As Variant, e As Range, Rng As Range, T As Date
  4.     Ar = Sheet2.[A5:A15].Value           '工作簿B
  5.     Ar = Application.Transpose(Ar)       '轉換為一維陣列
  6.     Ar = "," & Join(Ar, ",") & ","       'Join(傳回字串):以","字串,連結一維陣列的元素為字串
  7.                                          
  8.     For Each e In Sheet1.[A3:A10]        '工作簿A
  9.         If InStr(Ar, "," & e & ",") Then '"," & e & "," => 唯一的字串,Ar中尋找這"唯一字串"的位置
  10.             If Rng Is Nothing Then       'InStr(Ar, "," & e & ",")<>0 (False)   => 有找到這"唯一字串"的位置
  11.                 Set Rng = e
  12.             Else
  13.                 Set Rng = Union(e, Rng)
  14.             End If
  15.         End If
  16.     Next
  17.     Rng.Parent.Activate                 '工作簿A
  18.     Rng.Interior.Color = vbRed
  19.     T = Time
  20.     Do
  21.         DoEvents
  22.         If Time - T > #12:00:01 AM# Then    '間隔 1秒
  23.             T = Time
  24.             If Rng.Interior.Color = vbRed Then
  25.                 Rng.Interior.Color = vbYellow
  26.             Else
  27.                 Rng.Interior.Color = vbRed
  28.             End If
  29.         End If
  30.     Loop
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
12
返回列表 上一主題