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

帖子: 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

非常感謝板大

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

: )

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

'Union 方法傳回兩個或多個範圍的合併範圍。
Option Explicit
Sub EX()
Dim Rng As Range
Set Rng = [A1:A5]
Set Rng = Union([A1:A5], [C5:C15])
MsgBox Rng.Address
End Sub

複製代碼

Q2:
為什麼沒有看到往下累加的欄位數，Rng可以往下一欄位跑呀??? 單看這樣好像只是原地閃同一個
看 Q1: 的說明
Q3:
有什麼方法可以把陣列值一次印出來嗎?? 而不用FOR迴圈跑

Option Explicit
Sub EX()
Dim AR()
AR = Array(5, 10, 15, 20)
[A1].Resize(1, UBound(AR) + 1) = AR
[A5].Resize(UBound(AR) + 1) = Application.WorksheetFunction.Transpose(AR)
MsgBox Join(AR, vbLf)
'WorksheetFunction.Transpose:轉置(工作表函數)
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 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迴圈跑

不好意思問題有點多

謝謝大大 :  )

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

Dim Rng As Range
Private Sub twinkle()
Dim t As Date
'設立 Rng的範圍 *********
With Worksheets(1)
For i = 1 To .Range("A65536").End(xlUp).Row
If .Range("A" & i).Interior.Color = 255 Then
.Range("A" & i).Interior.Color = -4105 '紅底的變成無填滿
'******將欄位記下來 *****
If Rng Is Nothing Then
Set Rng = Range("A" & i)
Else
Set Rng = Union(Rng, Range("A" & i))
End If
'******將欄位記下來 *****
End If
Next
End With
t = Time
'**********儲存格閃爍 ******
Do
DoEvents
If Time - t > TimeValue("00:00:01") Then
t = Time
Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
End If
Loop
'**********儲存格閃爍 ******
End Sub

複製代碼

回復 11# li_hsien
11# 的程式碼(請複製於一般模組 (Module1)中試試
以下程式碼也是請複製於一般模組試試

Dim Rng As Range, Msg As Boolean '在模組頂端設立這模組可用之變數
Sub twinkle()
Msg = False
'設立 Rng的範圍 *********
With Worksheets(1)
For i = 1 To .Range("A65536").End(xlUp).Row
If .Range("A" & i).Interior.Color = 255 Then
.Range("A" & i).Interior.Color = -4105 '紅底的變成無填滿
'******將欄位記下來 *****
If Rng Is Nothing Then
Set Rng = Range("A" & i)
Else
Set Rng = Union(Rng, Range("A" & i))
End If
'******將欄位記下來 *****
End If
Next
End With
Application.Wait Time + #12:00:01 AM# '等候1秒鐘
SetRangeFlashing '執行這程序
End Sub
Private Sub SetRangeFlashing() '儲存格閃爍
If Msg = True Then
Rng.Interior.Color = 255 '還原紅色
Exit Sub
End If
Rng.Interior.Color = IIf(Rng.Interior.Color = 255, -4105, 255)
Application.OnTime Time + #12:00:01 AM#, "SetRangeFlashing"
End Sub
Sub Stop_Flashing() '停止儲存格閃爍
Msg = True
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 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

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

我的執行方式是

Sub test()
SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
End Sub
Static Sub SetRangeFlashing(Optional Target, Optional ColorIndex, Optional bQuit As Boolean)
'使用方法:
' 要開始閃爍請呼叫：
'SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
' 要停止閃爍請呼叫：SetRangeFlashing bQuit:=True
Dim dteNextTime As Date
Dim bStatus As Boolean
Dim RecordColor
Dim rngFlash As Range
If bQuit Then
rngFlash.Interior.ColorIndex = RecordColor
Application.OnTime dteNextTime, "SetRangeFlashing", , False
Else
If Not IsMissing(Target) Then Set rngFlash = Target
If Not IsMissing(ColorIndex) Then RecordColor = ColorIndex
rngFlash.Interior.ColorIndex = IIf(bStatus, RecordColor, xlColorIndexNone)
bStatus = Not bStatus
dteNextTime = Now + TimeValue("00:00:01")
Application.OnTime dteNextTime, "SetRangeFlashing"
End If
End Sub

複製代碼

不知道這樣跑程式是不是正確的

麻煩大大幫我看看

謝謝 : )