12
返回列表 上一主題 發帖

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

li_hsien

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

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


   

不知道為什麼執行起來會說巨集有問題
重開了也是一樣
不清楚錯在哪

我的執行方式是
  1. Sub test()
  2.     SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
  3. End Sub

  5. Static Sub SetRangeFlashing(Optional Target, Optional ColorIndex, Optional bQuit As Boolean)
  6.    
  7.     '使用方法:
  8.     '  要開始閃爍請呼叫：
  9.     'SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
  10.     '  要停止閃爍請呼叫：SetRangeFlashing bQuit:=True

  12.     Dim dteNextTime As Date
  13.     Dim bStatus As Boolean
  14.     Dim RecordColor
  15.     Dim rngFlash As Range
  16.    
  17.     If bQuit Then
  18.       rngFlash.Interior.ColorIndex = RecordColor
  19.       Application.OnTime dteNextTime, "SetRangeFlashing", , False
  20.     Else
  21.       If Not IsMissing(Target) Then Set rngFlash = Target
  22.       If Not IsMissing(ColorIndex) Then RecordColor = ColorIndex
  23.      
  24.       rngFlash.Interior.ColorIndex = IIf(bStatus, RecordColor, xlColorIndexNone)
  25.       bStatus = Not bStatus
  26.       dteNextTime = Now + TimeValue("00:00:01")
  27.       Application.OnTime dteNextTime, "SetRangeFlashing"
  28.     End If
  29.    
  30. 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兔年全勤獎章
12#
發表於 2013-11-27 11:58 | 只看該作者
本帖最後由 GBKEE 於 2013-11-27 14:14 編輯

回復 10# li_hsien
  1. Dim Rng As Range
  2. Private Sub twinkle()
  3.     Dim t As Date
  4.     '設立 Rng的範圍 *********
  5.     With Worksheets(1)
  6.     For i = 1 To .Range("A65536").End(xlUp).Row
  7.         If .Range("A" & i).Interior.Color = 255 Then
  8.             .Range("A" & i).Interior.Color = -4105  '紅底的變成無填滿
  9.             '******將欄位記下來 *****
  10.             If Rng Is Nothing Then
  11.                 Set Rng = Range("A" & i)
  12.             Else
  13.                 Set Rng = Union(Rng, Range("A" & i))
  14.             End If
  15.             '******將欄位記下來 *****
  16.         End If
  17.     Next
  18.     End With
  19.     t = Time
  20.     '**********儲存格 閃爍  ******
  21.     Do
  22.     DoEvents
  23.         If Time - t > TimeValue("00:00:01") Then
  24.             t = Time
  25.             Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
  26.         End If
  27.     Loop
  28.     '**********儲存格 閃爍  ******
  29. End Sub
複製代碼
回復 11# li_hsien
11# 的程式碼(請複製於一般模組 (Module1)中 試試
以下程式碼也是請複製於一般模組試試
  1. Dim Rng As Range, Msg As Boolean    '在模組頂端設立這模組可用之變數
  2. Sub twinkle()
  3.     Msg = False
  4.     '設立 Rng的範圍 *********
  5.     With Worksheets(1)
  6.         For i = 1 To .Range("A65536").End(xlUp).Row
  7.             If .Range("A" & i).Interior.Color = 255 Then
  8.                 .Range("A" & i).Interior.Color = -4105  '紅底的變成無填滿
  9.                 '******將欄位記下來 *****
  10.                 If Rng Is Nothing Then
  11.                     Set Rng = Range("A" & i)
  12.                 Else
  13.                     Set Rng = Union(Rng, Range("A" & i))
  14.                 End If
  15.                 '******將欄位記下來 *****
  16.             End If
  17.         Next
  18.     End With
  19.     Application.Wait Time + #12:00:01 AM#  '等候1秒鐘
  20.     SetRangeFlashing                       '執行這程序
  21. End Sub
  22. Private Sub SetRangeFlashing() '儲存格 閃爍
  23.     If Msg = True Then
  24.         Rng.Interior.Color = 255   '還原紅色
  25.         Exit Sub
  26.     End If
  27.     Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
  28.     Application.OnTime Time + #12:00:01 AM#, "SetRangeFlashing"
  29. End Sub
  30. Sub Stop_Flashing()   '停止儲存格閃爍
  31.     Msg = True
  32. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

li_hsien

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

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

請問一下板大
Q1:
Set Rng = Union(Rng, Range("A" & i))
union的用法是??? 把range("A"& i) 加入Rng裡面嗎??
Rng是陣列嗎??? 還是???

Q2:
  '**********儲存格 閃爍  ******
    Do
    DoEvents
        If Time - t > TimeValue("00:00:01") Then
            t = Time
            為什麼沒有看到往下累加的欄位數，Rng可以往下一欄位跑呀??? 單看這樣好像只是原地閃同一個
            Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
        End If
    Loop
    '**********儲存格 閃爍  ******

Q3:
另外還想請問板大
有什麼方法可以把陣列值一次印出來嗎??
而不用FOR迴圈跑



不好意思問題有點多

謝謝大大    :  )

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2013-11-28 15:52 | 只看該作者
回復 13# li_hsien
Q1:
     Set Rng = Union(Rng, Range("A" & i))
    union的用法是??? 把range("A"& i) 加入Rng裡面嗎?? :沒錯Rng是陣列嗎??? 是Range
  1. 'Union 方法 傳回兩個或多個範圍的合併範圍。
  2. Option Explicit
  3. Sub EX()
  4. Dim Rng As Range
  5. Set Rng = [A1:A5]
  6. Set Rng = Union([A1:A5], [C5:C15])
  7. MsgBox Rng.Address
  8. End Sub
複製代碼

Q2:
     為什麼沒有看到往下累加的欄位數，Rng可以往下一欄位跑呀??? 單看這樣好像只是原地閃同一個
     看 Q1: 的說明
Q3:
有什麼方法可以把陣列值一次印出來嗎?? 而不用FOR迴圈跑
  1. Option Explicit
  2. Sub EX()
  3. Dim AR()
  4. AR = Array(5, 10, 15, 20)
  5. [A1].Resize(1, UBound(AR) + 1) = AR
  6. [A5].Resize(UBound(AR) + 1) = Application.WorksheetFunction.Transpose(AR)
  7. MsgBox Join(AR, vbLf)
  8. 'WorksheetFunction.Transpose:轉置(工作表函數)
  9. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

li_hsien

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

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

非常感謝板大

我又多了好多經驗值了!!!

:   )

TOP

        靜思自在 : 君子如水，隨方就圓，無處不自在。
12
返回列表 上一主題