Board logo

標題: [發問] 兩個問題:比對迴圈 & 儲存格閃爍 [打印本頁]

作者: li_hsien    時間: 2013-11-26 10:42     標題: 兩個問題:比對迴圈 & 儲存格閃爍

Q1:
假設我有一組資料要比對
EX: 工作簿A 比對 工作簿B  在工作簿A上顯示 111,222,333,..的值
<工作簿A>                           
B 222
A 111
C 333
D 444
C 333

<工作簿B>(對照表)
A 111
B 222
C 333
D 444
E 555
F 666
G 777
                                                         
目前我都是用最直覺的For迴圈(跑2個-> 一個為工作簿A的數量(i),另一為工作簿B的數量(j))來處理
但如果資料量大 比對很耗時
請問大大有什麼更有效率的方式嗎???
(用函數vlookup會比較快嗎?? 但我不太會將函數應用在VBA語法上,而且vlookup必須多拉一個欄位來放值吧?)


Q2:
我想讓紅色底的儲存格閃爍
當作警示作用
以下這是很笨的想法 哈哈
而且程式會一直執行,卡住無法做其他事
  1.     Do
  2.         If Range("B2").Interior.ColorIndex = 3 Then
  3.             Application.Wait (Now + TimeValue("0:00:01"))
  4.             Range("B2").Interior.ColorIndex = -4142
  5.         End If
  6.         If Range("B2").Interior.ColorIndex = -4142 Then
  7.             Application.Wait (Now + TimeValue("0:00:01"))
  8.             Range("B2").Interior.ColorIndex = 3
  9.         End If
  10.     Loop
複製代碼
想說一次將2問題放一個提問,才不占論壇版面
內文有點冗長 , 麻煩各位大大   謝謝  :  )
作者: GBKEE    時間: 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
複製代碼

作者: li_hsien    時間: 2013-11-26 13:36

回復 2# GBKEE

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

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

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

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


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

感謝大大的幫忙    謝謝   :  )
作者: GBKEE    時間: 2013-11-26 15:24

回復 3# li_hsien
要有時間的間隔,來改變儲存格的底色,才會造成儲存格閃爍的視覺效果.
DeEvents : 交回控制權回給系統,
只要讓原本是紅色的那幾個閃爍 : 你就指定哪些儲存格
作者: stillfish00    時間: 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

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

作者: li_hsien    時間: 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
複製代碼
不知該怎麼修

麻煩大大幫我看看  謝謝  :  )
作者: li_hsien    時間: 2013-11-26 18:36

回復 5# stillfish00


    stillfish00 大大
    我不知該怎麼執行耶...

    直接COPY 可是他不能RUN

    是因為static嗎? 還是我需要有什麼前置的語法??
作者: stillfish00    時間: 2013-11-26 21:37

回復 7# li_hsien
我只是單純回答Q2的問題,插入程式碼後,1樓Q2的代碼可換為
SetRangeFlashing Target:=Range("B2"), ColorIndex:=3
使B2儲存格閃爍。

不適用迴圈中,而是用在最後要指定範圍閃爍的時候。
作者: GBKEE    時間: 2013-11-27 07:02

回復 6# li_hsien
請附檔說明你的範圍
作者: li_hsien    時間: 2013-11-27 09:40

回復 9# GBKEE

這是我的測試檔案

主要想法是先跑一次整列,將儲存格為紅底的變成無填滿
並且將欄位記下來,再過一秒鐘,讀取陣列中的欄位
把儲存格再變成紅色

不過我跑起來好像閃爍的不穩定XDD
而且陣列會一直倍數成長
有想說重跑就erase一次
可是他就不行跑了

麻煩大大 幫我看看 謝謝

    [attach]16883[/attach]
作者: li_hsien    時間: 2013-11-27 10:06

回復 8# stillfish00


    [attach]16884[/attach]

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

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

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

  10.     Dim dteNextTime As Date
  11.     Dim bStatus As Boolean
  12.     Dim RecordColor
  13.     Dim rngFlash As Range
  14.    
  15.     If bQuit Then
  16.       rngFlash.Interior.ColorIndex = RecordColor
  17.       Application.OnTime dteNextTime, "SetRangeFlashing", , False
  18.     Else
  19.       If Not IsMissing(Target) Then Set rngFlash = Target
  20.       If Not IsMissing(ColorIndex) Then RecordColor = ColorIndex
  21.      
  22.       rngFlash.Interior.ColorIndex = IIf(bStatus, RecordColor, xlColorIndexNone)
  23.       bStatus = Not bStatus
  24.       dteNextTime = Now + TimeValue("00:00:01")
  25.       Application.OnTime dteNextTime, "SetRangeFlashing"
  26.     End If
  27.    
  28. End Sub
複製代碼
不知道這樣跑程式是不是正確的

麻煩大大幫我看看

謝謝  :   )
作者: GBKEE    時間: 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
複製代碼

作者: li_hsien    時間: 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    時間: 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
複製代碼

作者: li_hsien    時間: 2013-11-28 16:50

回復 14# GBKEE

非常感謝板大

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

:   )




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)