麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 此巨集為何錯?? [打印本頁]

作者: t8899 時間: 2013-8-2 15:26 標題: 此巨集為何錯??

本帖最後由 t8899 於 2013-8-2 15:27 編輯

Private Sub Worksheet_Calculate()
      Dim xx As Range
For Each xx In Range("AG2:AG111")
If IsError(xx) Then
   If xx > xx.Offset(, -1) And Range("Q24").Value = 1 And flag = True Then
CreateObject("Wscript.shell").Popup "===> " & Cells(xx.Row, 2).Value & "=====> " & xx.Value, 1, "Auto Closed MsgBox", 64
Range("Q24").Value = 2
Application.OnTime Now + TimeValue("00:00:15"), "DDD"
   Exit For
   End If
   End If
Next
end sub
錯誤訊息型態不符合 ==>紅色行

作者: t8899 時間: 2013-8-2 15:48

一開檔才會有錯誤，但跑時是正常的
一開檔dde 連結 AG2:AG111 儲存格會2秒的錯誤訊息, 接著就正常,應該是這原因??
要把AG2:AG111 的錯誤忽略才行 ,才會用]If IsError(xx)

作者: t8899 時間: 2013-8-2 18:55

已解決
If IsError(xx) Then 弄反了
If not IsError(xx) Then 才對

作者: t8899 時間: 2013-8-2 19:05

如果 AG2:AG111 有10個同時達到條件
會連續10個對話盒出現??
可以將10個放進1個對話盒出現嗎

作者: luhpro 時間: 2013-8-2 23:59

本帖最後由 luhpro 於 2013-8-3 00:01 編輯

回復 4# t8899
因為沒實際的檔案資料可以驗證結果,
試試看底下的程式碼是否符合你的需求.

Dim sStr$
Dim xx As Range
sStr = ""
For Each xx In Range("AG2:AG111")
If Not IsError(xx) Then
If xx > xx.Offset(, -1) And Range("Q24").Value = 1 And flag = True Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "===> " & Cells(xx.Row, 2).Value & "=====> " & xx.Value
Range("Q24").Value = 2
Application.OnTime Now + TimeValue("00:00:15"), "DDD"
Exit For
End If
End If
Next
If sStr <> "" Then CreateObject("Wscript.shell").Popup sStr, 1, "Auto Closed MsgBox", 64

複製代碼

作者: t8899 時間: 2013-8-3 06:49

回復 t8899
因為沒實際的檔案資料可以驗證結果,
試試看底下的程式碼是否符合你的需求.
luhpro 發表於 2013-8-2 23:59

謝謝!
已測試，符合條件中只會傳第一個
附檔請測試[attach]15673[/attach]

作者: luhpro 時間: 2013-8-3 08:54

回復 6# t8899
把 Exit For 拿掉,
不然當條件成立後,
迴圈只會執行一次.

Private Sub Worksheet_Calculate()
Dim sStr$
Dim xx As Range
sStr = ""
For Each xx In Range("f2:F54")
If Not IsError(xx) Then
If xx > xx.Offset(, -1) And Range("I1").Value = 1 Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "===> " & Cells(xx.Row, 2).Value & "=====> " & xx.Value
'Exit For <===== 拿掉
End If
End If
Next
If sStr <> "" Then CreateObject("Wscript.shell").Popup sStr, 1, "Auto Closed MsgBox", 64
End Sub

複製代碼

作者: t8899 時間: 2013-8-3 09:47

回復 t8899
把 Exit For 拿掉,
不然當條件成立後,
迴圈只會執行一次.
luhpro 發表於 2013-8-3 08:54

可以了，謝謝指導!

作者: t8899 時間: 2013-8-3 10:08

回復 t8899
把 Exit For 拿掉,
不然當條件成立後,
迴圈只會執行一次.
luhpro 發表於 2013-8-3 08:54

想再多加一個條件
f2:F54 超過 5個以上條件才成立
要如何改?

作者: luhpro 時間: 2013-8-3 10:29

想再多加一個條件
f2:F54 超過 5個以上條件才成立
要如何改?
t8899 發表於 2013-8-3 10:08

超過 5個以上?
那就邊處理邊計數囉:

Private Sub Worksheet_Calculate()
Dim lCount As Long
Dim sStr$
Dim xx As Range
sStr = ""
lCount = 0
For Each xx In Range("f2:F54")
If Not IsError(xx) Then
If xx > xx.Offset(, -1) And Range("I1").Value = 1 Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "===> " & Cells(xx.Row, 2).Value & "=====> " & xx.Value
lCount = lCount + 1
End If
End If
Next
If sStr <> "" And lCount > 5 Then CreateObject("Wscript.shell").Popup sStr, 1, "Auto Closed MsgBox", 64
End Sub

複製代碼

作者: t8899 時間: 2013-8-3 10:50

超過 5個以上?
那就邊處理邊計數囉:
luhpro 發表於 2013-8-3 10:29

是否會太消眊系統資源??

作者: luhpro 時間: 2013-8-3 10:58

回復 11# t8899
相比程式中其他部分的動作來說,

這只是將某個變數做加1 的動作,

資源消耗幾乎可以不計.

作者: t8899 時間: 2013-8-4 09:57

回復 t8899
相比程式中其他部分的動作來說,

這只是將某個變數做加1 的動作,

資源消耗幾乎可以不計 ...
luhpro 發表於 2013-8-3 10:58

抱歉，再打擾一下
條件想改成
只有 Range("f2:F54") 變動超過 1% 則條件成立(Range("f2:F54") 為DDE連結)
例如 100 變成 101 或 99 則成立

作者: luhpro 時間: 2013-8-4 21:44

抱歉，再打擾一下
條件想改成
只有 Range("f2:F54") 變動超過 1% 則條件成立(Range("f2:F54") 為DDE連 ...
t8899 發表於 2013-8-4 09:57

改成這個應該不困難啊:

If Int(xx - xx.Offset(, -1)) >= 0.01 And Range("I1").Value = 1 Then

作者: t8899 時間: 2013-8-4 22:24

本帖最後由 t8899 於 2013-8-4 22:27 編輯

改成這個應該不困難啊:

If Int(xx - xx.Offset(, -1)) >= 0.01 And Range("I1").Value = 1 Then
luhpro 發表於 2013-8-4 21:44

Range("f2:F54")  變動超過 1%
是自欄跟自欄比較不是跟 E欄(xx.Offset(, -1)) 比較
即變動後-變動前 >1%或<1%  顯示相減的值 BOX(須顯示增加還是減少)

另外下面這段程式碼顯示的對話盒為何沒換行??

Dim sStr2$
Dim ZZ As Range
   sStr2 = ""
For Each ZZ In Range("c2:c111")
If Not IsError(ZZ) Then
   If ZZ > ZZ.Offset(, 26) * 1.01 Or ZZ < ZZ.Offset(, 26) * 0.99 And Range("Q26").Value = 1 And flag = True Then
      If sStr2 <> "" Then sSt2r = sStr2 & Chr(10)
      sStr2 = sStr2 & "個股與上一盤===> " & Cells(ZZ.Row, 2).Value & "=====> " & ZZ.Value


      ' Exit For
   End If
End If
  Next
  If sStr2 <> "" Then CreateObject("Wscript.shell").Popup sStr2, 2, "Auto Closed MsgBox", 64
Range("Q26").Value = 2
      Application.OnTime Now + TimeValue("00:00:15"), "FFF"

作者: luhpro 時間: 2013-8-4 22:39

本帖最後由 luhpro 於 2013-8-4 22:40 編輯

Range("f2:F54") 變動超過 1%
是自欄跟自欄比較不是跟 E欄(xx.Offset(, -1)) 比較
即變動後-變動前 ...
t8899 發表於 2013-8-4 22:24

Excel 並不能抓取任一儲存格於 "變動前" 的值,
除非你事先把它存起來,
所以你可以考慮比較完立刻把目前的值存放到該列某欄(或是陣列, Dictionary...)上,
到下次需要時再將目前的值與該欄(或是陣列, Dictionary...)做比較.

至於你說的沒有換行...
If sStr2 <> "" Then sSt2r = sStr2 & Chr(10)
紅字的 2r 與 r2 不同,
這就不是 sStr2 變數了喔.

作者: t8899 時間: 2013-8-5 04:35

Excel 並不能抓取任一儲存格於 "變動前" 的值,
除非你事先把它存起來,
所以你可以考慮比較完立刻把目前 ...
luhpro 發表於 2013-8-4 22:39

我上面的就是如此寫的,因為有or判斷
在輸出時，如何改為
1. 如ZZ > ZZ.Offset(, 26) * 1.01 ,則輸出 "漲" 及 ZZ 與 ZZ.Offset(, 26) * 1.01 之差
2. 如ZZ < ZZ.Offset(, 26) * 1.01 ,則輸出 "跌" 及 ZZ 與 ZZ.Offset(, 26) * 1.01 之差
================================================
此句 Application.OnTime Now + TimeValue("00:00:15"), "ccc" , 是否會跑 AAA,BBB ??

Sub AAA()
Sheet4.Range("Q1").Value = 1
End Sub
------------------
Sub BBB()
Sheet4.Range("Q12").Value = 1
End Sub
------------------
Sub CCC()
Sheet4.Range("Q20").Value = 1
End Sub
=============================================
執行巨集時，如何不佔用目前工作表視窗 ??
假如畫面在 sheet4 上,執行以下巨集
如何讓它不切到sheet3,一直停在sheet4 上

Sub FFF()
Sheets("Sheet3").Select
Range("C2:C111").Select
Selection.Copy
Range("AC2").Select
'貼上值與數字格式
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
      xlNone, SkipBlanks:=False, Transpose:=False
                  Range("E2").Select
            End Sub

作者: t8899 時間: 2013-8-5 07:21

本帖最後由 t8899 於 2013-8-5 07:34 編輯

下面此段工作表有變動，但條件未達到(flag=false)，最後一行 Application.OnTime Now + TimeValue("00:00:15"), "DDD"仍會執行 ??
放的位置不對??要擺在那裡?
Private Sub Worksheet_Calculate()
  Dim sStr$
  Dim xx As Range
  sStr = ""
  For Each xx In Range("AG2:AG50")
If Not IsError(xx) Then
   If xx > xx.Offset(, -1) And Range("Q24").Value = 1 And flag = True Then
      If sStr <> "" Then sStr = sStr & Chr(10)
      sStr = sStr & "單量===> " & Cells(xx.Row, 2).Value & "=====> " & xx.Value
      ' Exit For
   End If
End If
  Next
  If sStr <> "" Then CreateObject("Wscript.shell").Popup sStr, 3, "Auto Closed MsgBox", 64
Range("Q24").Value = 2
      Application.OnTime Now + TimeValue("00:00:15"), "DDD"
end sub
---------------------------------------------------------
Sub DDD()
Sheet4.Range("Q24").Value = 1
End Sub

作者: luhpro 時間: 2013-8-6 23:25

本帖最後由 luhpro 於 2013-8-6 23:30 編輯

我上面的就是如此寫的,因為有or判斷
在輸出時，如何改為
1. 如ZZ > ZZ.Offset(, 26) * 1.01 ,則輸出 "漲" 及 ZZ 與 ZZ.Offset(, 26) * 1.01 之差
2. 如ZZ < ZZ.Offset(, 26) * 1.01 ,則輸出 "跌" 及 ZZ 與 ZZ.Offset(, 26) * 1.01 之差
t8899 發表於 2013-8-5 04:35

因為沒有你實際的程式內容,
所以只好拿你之前的程式來修改,
你再參照著應用.

Private Sub Worksheet_Calculate()
Dim lCount As Long, lDir As Long
Dim sStr$
Dim ZZ As Range
Dim rRoF()
rRoF = Array("跌", "漲")
sStr = ""
lCount = 0
For Each ZZ In Range("f2:F54")
If Not IsError(ZZ) Then
lDir = ZZ - ZZ.Offset(, -1)
If Abs(lDir) > 0.01 And Range("I1").Value = 1 Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "===> " & Cells(ZZ.Row, 2).Value & "=====> " & rRoF(-(lDir > 0)) & " " & Abs(lDir)
lCount = lCount + 1
End If
End If
Next
If sStr <> "" And lCount > 5 Then CreateObject("Wscript.shell").Popup sStr, 15, "Auto Closed MsgBox", 64
End Sub

複製代碼

此句 Application.OnTime Now + TimeValue("00:00:15"), "ccc" , 是否會跑 AAA,BBB ??

不會, 你已經指定它去跑 ccc 了,
除非你在 ccc 中有加上 Call AAA 及 Call BBB.

執行巨集時，如何不佔用目前工作表視窗 ??

將不想出現切換動作的地方的 .select 拿掉,(相對的有 Selection 的地方也要修改)
或是在不想畫面變動的區間以
Application.EnableEvents = False 及
Application.EnableEvents = true 包覆.

下面此段工作表有變動，但條件未達到(flag=false)，最後一行 Application.OnTime Now + TimeValue("00:00:1 ...
t8899 發表於 2013-8-5 07:21

改成 :
If flag Then Application.OnTime Now + TimeValue("00:00:15"), "DDD"

作者: t8899 時間: 2013-8-7 06:33

本帖最後由 t8899 於 2013-8-7 06:46 編輯

luhpro 發表於 2013-8-6 23:25

將不想出現切換動作的地方的 .select 拿掉,(相對的有 Selection 的地方也要修改)

.select 拿掉就沒辦法執行我想要做這指令的動作
還是有其他指令可替換??
或是執行前記住"目前sheet"，執行完自動回原sheet 的指令?

或是在不想畫面變動的區間以
Application.EnableEvents = False 及
Application.EnableEvents = true 包覆.
Application.ScreenUpdating=False
Application.ScreenUpdating=True

試過皆無效

作者: t8899 時間: 2013-8-7 19:22

本帖最後由 t8899 於 2013-8-7 19:25 編輯

luhpro 發表於 2013-8-6 23:25

下面兩組條件同時達到條件
不知為何第二組的對話盒不會自動關閉
如果把第二組與第一組先後互換，又換第一組不會自動關閉
  Private Sub Worksheet_Calculate()
   Dim sStr$
Dim ZZ As Range
   sStr = ""
   sStr2 = ""
For Each ZZ In Range("c2:c111")
If Not IsError(ZZ) Then
   If ZZ > ZZ.Offset(, 26) * Range("S26").Value And Range("Q26").Value = 1 And flag = True Then
      If sStr <> "" Then sStr = sStr & Chr(10)
      sStr = sStr & "漲漲漲--與上一盤===> " & Cells(ZZ.Row, 2).Value & "=====> " & Round((ZZ - ZZ.Offset(, 26)) / ZZ.Offset(, 26).Value, 4) * 100
               End If
                     If ZZ < ZZ.Offset(, 26) * Range("R26").Value And Range("Q26").Value = 1 And flag = True Then
      If sStr2 <> "" Then sStr2 = sStr2 & Chr(10)
      sStr2 = sStr2 & "跌跌跌--與上一盤===> " & Cells(ZZ.Row, 2).Value & "=====> " & Round((ZZ - ZZ.Offset(, 26)) / ZZ.Offset(, 26).Value, 4) * 100
         End If
End If
   Next

'第一組
   If sStr2 <> "" Then
  CreateObject("Wscript.shell").Popup sStr2, 2, "Auto Closed MsgBox", 64
Range("Q26").Value = 2
Application.OnTime Now + TimeValue("00:00:15"), "fff"
   End If
   '第二組
   If sStr <> "" Then
  CreateObject("Wscript.shell").Popup sStr, 2, "Auto Closed MsgBox", 64
Range("Q26").Value = 2
Application.OnTime Now + TimeValue("00:00:15"), "fff"
      End If
End Sub

作者: luhpro 時間: 2013-8-7 23:11

下面兩組條件同時達到條件
不知為何第二組的對話盒不會自動關閉
如果把第二組與第一組先後互換，又換第 ...
t8899 發表於 2013-8-7 19:22

我猜應該是這個函數只有(或是不管呼叫幾次都共用)一個計數器,
當此計數器歸零後除非再次觸發(再呼叫)才會重新計數.

作者: t8899 時間: 2013-8-8 08:53

我猜應該是這個函數只有(或是不管呼叫幾次都共用)一個計數器,
當此計數器歸零後除非再次觸發(再呼叫)才會 ...
luhpro 發表於 2013-8-7 23:11

詳細測試原來是第一組的 Application.OnTime Now + TimeValue("00:00:15"), "fff" 的問題
拿掉就正常,不知有無辦法解決此問題?

作者: luhpro 時間: 2013-8-9 00:15

回復 23# t8899
剛剛想到一個不一定符合你需求的辦法,

在 CreateObject 指令上方放一個條件式,
若還有 CreateObject 指令執行中的話, (分別在兩個 CreateObject 上方放 bFlag1或2 = true下方則設該值為False 作為是否執行中的判斷 )
就暫停兩秒後再執行 CreateObject 指令,
讓其依續錯開,
缺點是若觸發的太頻繁,
可能程式會因為來不及消化而發生異常.

作者: t8899 時間: 2013-8-12 19:18

回復 t8899
剛剛想到一個不一定符合你需求的辦法,
luhpro 發表於 2013-8-9 00:15

之前的問題, 測試某指定範圍儲存格超過1%就通知
DDE 連結取得數據有誤 ??
測得 F2:F54 任一欄位變動超過1%, 以MSBOX通知
開檔不更新一切正常(直接改鍵盤輸入是正常)
但更新後會錯在
If Val(sz(i, 1)) = 0# Then 此行
型態不符合??不知如何解決? (已附檔)[attach]15762[/attach]

作者: luhpro 時間: 2013-8-12 22:51

回復 25# t8899
你的sz(i, 1) 我看到的值是 : 錯誤 2023
這在 VB 來看是一個字串,
它不讓用 Val() 來轉換成數字,(所以會出現 13 的錯誤)
我建議用 CLng( 來取代 Val(
全部代換即可. (當然前提是類似上述字串的內容, 你仍然希望經過該 Sub 而不是做例外處理)

Sub 檢查()
Dim n, sz1, str As String
sz1 = Sheets("Sheet1").Range("F2:F54")
str = ""
For i = 1 To UBound(sz1)
If CLng(sz(1, 1)) = 0 Then
If CLng(sz1(i, 1)) <> 0# Then str = str & vbCrLf & "單元格 F" & i + 1 & " =========" & " B" & i + 1 & "=" & Sheets("Sheet1").Cells(i + 1, 2).Value
Else
n = Round((CLng(sz1(i, 1)) - CLng(sz(i, 1))) / CLng(sz(i, 1)) * 100, 2)
If Abs(n) >= 1 Then str = str & vbCrLf & Sheets("Sheet1").Cells(i + 1, 2).Value & "===>" & n
End If
Next i
If Len(str) > 0 Then
sz = Sheets("Sheet1").Range("F2:F54")
' MsgBox str, , "提示"
CreateObject("Wscript.shell").Popup "" & str, 3, "Auto Closed MsgBox", 64
End If
End Sub

複製代碼

作者: t8899 時間: 2013-8-13 13:14

回復 t8899
你的sz(i, 1) 我看到的值是 : 錯誤 2023
這在 VB 來看是一個字串,
它不讓用 Val() 來轉換 ...
luhpro 發表於 2013-8-12 22:51

謝謝
測試沒問題了
我想再最後加上輸出，變動前，跟變動後的值

作者: t8899 時間: 2013-8-13 21:27

回復 27# t8899
抱歉, 已解決
& sz(i, 1) & "===>" & sz1(i, 1)

作者: t8899 時間: 2013-8-13 22:10

本帖最後由 t8899 於 2013-8-13 22:13 編輯

計算有誤 ????

變動後變動前變動前
(CLng(sz1(i, 1)) - CLng(sz(i, 1))) / CLng(sz(i, 1)) * 100

左第一個數字===>漲幾%
第二個數字 ===>變動前
第三個數字 ===>變動後

像第一個兆豐金正確應為漲7.29 (不是 8.7 )
矽品也不對
[attach]15766[/attach]

作者: luhpro 時間: 2013-8-13 22:30

回復 29# t8899
晤...
若是會有小數出現的數值,
那就要把 CLng( 用 CSng( 來取代就可以了.

作者: t8899 時間: 2013-8-13 22:30

我換回用 VAL 測是正確的, 不知還有其他類似的語法??
[attach]15767[/attach]

作者: t8899 時間: 2013-8-14 07:11

本帖最後由 t8899 於 2013-8-14 07:14 編輯

回復 t8899
晤...
若是會有小數出現的數值,
那就要把 CLng( 用 CSng( 來取代就可以了.
luhpro 發表於 2013-8-13 22:30

模組裡有一個耀輸1, 程式碼為Public sz
是否錯誤??
應該為 Public sz as ???
耀輸1 這名字好像不能改，改了程式會錯誤?

作者: c_c_lai 時間: 2013-8-14 07:52

模組裡有一個耀輸1, 程式碼為Public sz
是否錯誤??
應該為 Public sz as ???
耀輸1 這名字好像不能改， ...
t8899 發表於 2013-8-14 07:11

[attach]15769[/attach]

作者: t8899 時間: 2013-8-14 08:43

c_c_lai 發表於 2013-8-14 07:52

為什麼只有 Public sz 語法錯誤還能運作??

作者: c_c_lai 時間: 2013-8-14 08:56

為什麼只有 Public sz 語法錯誤還能運作??
t8899 發表於 2013-8-14 08:43

宣告 Public sz 語法並沒錯誤，它因事先無明確型態宣告，
故會在後續的應用上，根據其相對應之型態而作為其型態宣告。
Public sz As Variant 只是將型態加以明確定義。
養成型態明確定義也是撰寫程式的一種好習慣。

作者: t8899 時間: 2013-8-14 09:23

本帖最後由 t8899 於 2013-8-14 09:32 編輯

宣告 Public sz 語法並沒錯誤，它因事先無明確型態宣告，
故會在後續的應用上，根據其相對應之型態而作 ...
c_c_lai 發表於 2013-8-14 08:56

我把漲跟跌改為分開，一開檔 falg=true 的狀態出現錯誤
把錯誤所在行後面的 & sz(i, 1) & "===>" & sz1(i, 1) 刪掉就正常
為何錯誤?為何不錯前面那一行?

[attach]15770[/attach]

作者: c_c_lai 時間: 2013-8-14 09:57

回復 36# t8899
[attach]15772[/attach]

作者: t8899 時間: 2013-8-14 10:37

本帖最後由 t8899 於 2013-8-14 10:39 編輯

回復 t8899
c_c_lai 發表於 2013-8-14 09:57

我的是1 ，我把它改為2 錯誤還是一樣
型態不符合

作者: c_c_lai 時間: 2013-8-14 10:41

本帖最後由 c_c_lai 於 2013-8-14 10:53 編輯

我的是1 ，我把它改為2 錯誤還是一樣
型態不符合
t8899 發表於 2013-8-14 10:37

& sz(i, 1) & "===>" & sz1(i, 1) 改成
& CStr(sz(i, 1)) & "===>" & CStr( sz1(i, 1)) 呢？

作者: t8899 時間: 2013-8-14 10:54

& sz(i, 1) & "===>" & sz1(i, 1) 改成
& CSng(sz(i, 1)) & "===>" &CSng( sz1(i, 1)) 呢？
c_c_lai 發表於 2013-8-14 10:41

這樣OK了!謝謝
(sz(i, 1),CSng(sz(i, 1)差異是??
前一行要一起改嗎??
為何不會錯在前一行??

作者: c_c_lai 時間: 2013-8-14 10:59

回復 40# t8899
因為我沒有你目前測試的檔案，
故無法一一推敲你的數據過程，
你是用 CStr() 還是 CSng() ?

作者: t8899 時間: 2013-8-14 11:46

回復 t8899
因為我沒有你目前測試的檔案，
故無法一一推敲你的數據過程，
你是用 CStr() 還是 CSng() ...
c_c_lai 發表於 2013-8-14 10:59

csng...............

作者: t8899 時間: 2013-8-14 19:21

回復 t8899
晤...
若是會有小數出現的數值,
那就要把 CLng( 用 CSng( 來取代就可以了.
luhpro 發表於 2013-8-13 22:30

如果輸出再增加到 sheet2 工作表的A1順序貼上
如果A1非空白，則B1 ....C1............D1
語法是?

作者: luhpro 時間: 2013-8-14 23:05

回復 43# t8899

Sub nn()
Dim i%
Dim lRows As Long
With Sheets("sheet2")
lRows = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(lRows + 1, 1) = Sheets("Sheet3").Cells(i + 1, 2).Value
'.
'.
'.
End With
End Sub

複製代碼

作者: t8899 時間: 2013-8-15 07:19

回復 t8899
luhpro 發表於 2013-8-14 23:05

謝謝您近日來熱心指導!

作者: t8899 時間: 2013-8-15 21:03

本帖最後由 t8899 於 2013-8-15 21:09 編輯

回復 t8899
luhpro 發表於 2013-8-14 23:05

最後一個問題
在最後輸出已達條件的對話盒後
之前符合條件的部份
將 zz之值拷到  ZZ.Offset(, 26) (已達條件的，再重新繞回來,才不會一直重覆出現)
----------------------
   Dim sStr$
Dim ZZ As Range
   sStr = ""
   sStr2 = ""
For Each ZZ In Range("c2:c111")
If Not IsError(ZZ) Then
      If Range("Q26").Value = 1 And flag = True Then
   M = Round(ZZ - ZZ.Offset(, 26), 2)
If M >= ZZ.Offset(, 2) Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "" & Cells(ZZ.Row, 2).Value & "=====> " & Round(ZZ - ZZ.Offset(, 26), 2)
               End If
If M <= -ZZ.Offset(, 2) Then
If sStr2 <> "" Then sStr2 = sStr2 & Chr(10)
  sStr2 = sStr2 & "" & Cells(ZZ.Row, 2).Value & "=====> " & Round(ZZ - ZZ.Offset(, 26), 2)
               End If
End If
End If
   Next
  If sStr <> "" Then
  CreateObject("Wscript.shell").Popup sStr, 4, "Auto Closed MsgBox", 64
   End If
   If sStr2 <> "" Then
  CreateObject("Wscript.shell").Popup sStr2, 4, "Auto Closed MsgBox", 64
   End If

作者: luhpro 時間: 2013-8-15 21:47

回復 46# t8899
因為漲跌兩邊都要執行,
所以會加兩行 :

Dim sStr$
Dim ZZ As Range
sStr = ""
sStr2 = ""
For Each ZZ In Range("c2:c111")
If Not IsError(ZZ) Then
If Range("Q26").Value = 1 And flag = True Then
M = Round(ZZ - ZZ.Offset(, 26), 2)
If M >= ZZ.Offset(, 2) Then
If sStr <> "" Then sStr = sStr & Chr(10)
sStr = sStr & "" & Cells(ZZ.Row, 2).Value & "=====> " _
& Round(ZZ - ZZ.Offset(, 26), 2)
ZZ.Offset(, 26) = ZZ ' <======= 加在這裡
End If
If M <= -ZZ.Offset(, 2) Then
If sStr2 <> "" Then sStr2 = sStr2 & Chr(10)
sStr2 = sStr2 & "" & Cells(ZZ.Row, 2).Value & "=====> " _
& Round(ZZ - ZZ.Offset(, 26), 2)
ZZ.Offset(, 26) = ZZ ' <======= 加在這裡
End If
End If
End If
Next
If sStr <> "" Then
CreateObject("Wscript.shell").Popup sStr, 4, "Auto Closed MsgBox", 64
End If
If sStr2 <> "" Then
CreateObject("Wscript.shell").Popup sStr2, 4, "Auto Closed MsgBox", 64
End If

複製代碼

另外,建議你可以參考類似上面這樣有做縮排處理的程式編寫習慣,
只需先找到區塊的某一邊,
直接按上或下鍵就能確認區塊的範圍,
這樣要找問題或是切入點會比較容易,
也比較不容易因為要找一些缺東缺西的問題而浪費寫程式的時間.

作者: t8899 時間: 2013-8-15 22:07

回復 t8899
因為漲跌兩邊都要執行,
所以會加兩行 :另外,建議你可以參考類似上面這樣有做縮排處理的程式 ...
luhpro 發表於 2013-8-15 21:47

訊息無法一次出現???會一隻一隻出現??

作者: t8899 時間: 2013-8-16 06:49

本帖最後由 t8899 於 2013-8-16 06:51 編輯

回復 t8899
因為漲跌兩邊都要執行,
所以會加兩行 :另外,建議你可以參考類似上面這樣有做縮排處理的程式 ...
luhpro 發表於 2013-8-15 21:47

應該是執行到 ZZ.Offset(, 26) = ZZ時，就跳出 for next 直接執行下面 ?迴圈沒跑完就跳出?

作者: t8899 時間: 2013-8-16 09:53

附檔[attach]15785[/attach]

作者: t8899 時間: 2013-8-16 15:48

回復 t8899
因為漲跌兩邊都要執行,
所以會加兩行 :另外,建議你可以參考類似上面這樣有做縮排處理的程式 ...
luhpro 發表於 2013-8-15 21:47

抱歉上一樓檔案有誤，請用這個檔案測試
[attach]15789[/attach]

作者: t8899 時間: 2013-8-16 18:47

ZZ.Offset(, 26) ====>可否直接改成AC欄的語法??

作者: luhpro 時間: 2013-8-17 09:11

本帖最後由 luhpro 於 2013-8-17 09:14 編輯

ZZ.Offset(, 26) ====>可否直接改成AC欄的語法??
t8899 發表於 2013-8-16 18:47

訊息無法一次出現???會一隻一隻出現??
t8899 發表於 2013-8-15 22:07

那是因為跑 ZZ.Offset(, 26) = ZZ 這一行指令時又會觸發 Calculate 事件,
導致又再一次進入了  Worksheet_Calculate 函式.
只要在執行此行指令時把觸發功能暫時禁能即可 :
將兩個
  ZZ.Offset(, 26) = ZZ
都改成
Application.EnableEvents = False
  ZZ.Offset(, 26) = ZZ
Application.EnableEvents = True
即可

ZZ.Offset(, 26) ====>可否直接改成AC欄的語法??
t8899 發表於 2013-8-16 18:47

Range.Offset 指令是傳回 :
以該Range為基準,
位移Offset右方括弧內所指定的列數與欄數後的儲存格位址.

此函式傳回的是個 "相對" 位置,
自然就不能用AC欄的語法啦.

ZZ.Offset(, 26)
就等於
Range(ZZ.Row, ZZ.Column + 26)

若堅持要改成AC欄語法勉強可以改為
Range("AC" & CStr(ZZ.Row))
因為列號是須要參考ZZ而做變動的,
而若日後你的 ZZ 改成不在 "C" 欄時,
上式傳回的位址就又不正確了.

作者: t8899 時間: 2013-8-18 09:11

本帖最後由 t8899 於 2013-8-18 09:21 編輯

若堅持要改成AC欄語法勉強可以改為
Range("AC" & CStr(ZZ.Row))
因為列號是須要參考ZZ而做變動的,
而若日後你的 ZZ 改成不在 "C" 欄時,
上式傳回的位址就又不正確了.
luhpro 發表於 2013-8-17 09:11

巨集裡的公式，好像不會跟著工作表變動參照??
例如 If Range("Q2").Value = 1
我在P欄插入一欄，巨集不會自動改為 If Range("R2").Value = 1 ?
如果要跟著變動改為
IF Range("Q2").Offset(, 0) = 1 ?是這樣嗎?

作者: luhpro 時間: 2013-8-19 22:20

巨集裡的公式，好像不會跟著工作表變動參照??
例如 If Range("Q2").Value = 1
我在P欄插入一欄，巨集不 ...
t8899 發表於 2013-8-18 09:11

巨集裏的程式片斷與儲存格本來就不是綁在一起而是各自獨立的,
Range("Q2") 永遠就是指 Q2 這個儲存格,
而在其右邊的 .Offset(xx,yy) 也只能對應到唯一一個儲存格,
而上列兩個儲存格並不會因為你在其前方插入欄列而跟著變動.

若需要相應的跟著儲存格做變動,
比較可行的方法我能想到的有兩種:
1. 在某個儲存格內下公式去參照到標的儲存格,而 Excel VBA 程式則透過參照位址做處理.(前提是不論怎麼插入欄列,都不能變動到參照儲存格的位置)
可藉由 Range(Mid(Cells(3,1).Formula,2)).Row 取得列號
可藉由 Range(Mid(Cells(3,1).Formula,2)).Column 取得欄號.

2. 對標的儲存格定義名稱,而 Excel VBA 程式則透過該名稱的位址做處理.
例如:
** 定義名稱為 Work 參照到 =Sheet1!$A$4
在 With ActiveWorkbook.Names("Work") 與 End With 之間:
可用 .Value 抓到 =Sheet1!$A$4 等文字,
再用 Range( Mid(.Value, InStr(1, .Value, "!") + 1)).Row 可抓到列號.
Range( Mid(.Value, InStr(1, .Value, "!") + 1)).Column 可抓到欄號.

作者: t8899 時間: 2013-8-22 04:35

本帖最後由 t8899 於 2013-8-22 04:47 編輯

巨集裏的程式片斷與儲存格本來就不是綁在一起而是各自獨立的,
Range("Q2") 永遠就是指 Q2 這個儲存格,
...
luhpro 發表於 2013-8-19 22:20

1.之前的問題，經再測試無法自動關掉訊息窗
是因為跑下面的程式,不知有無辦法改善?
好像只要有在跑time 的程式，就會這樣
Sub a123()
If [U1] <> 1 Then
On Error Resume Next
Application.OnTime EarliestTime:=TimeValue(Runtime), _
Procedure:="a123", Schedule:=False
  Exit Sub
On Error GoTo 0
End If
zzzzz
If Range("V14") = 1 Then mytime = "00:01:00"
If Range("V14") = 2 Then mytime = "00:02:00"
If Range("V14") = 3 Then mytime = "00:00:30"
Runtime = Now + TimeValue(mytime)
Application.OnTime Runtime, "Sheet6.a123"
End Sub

2.後來找了一個API(MsgBoxTest)套用,代替CreateObject("Wscript.shell").Popup，
有問題??型態不符合???錯在紅色字?

Private Declare Function MsgBoxTest Lib "user32" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As VbMsgBoxStyle, _
ByVal wlange As Long, _
ByVal dwTimeout As Long) As Long
Private Sub Worksheet_Calculate()
Application.DisplayStatusBar = False
  Dim sStr$
  Dim ZZ As Range

  sStr = ""
  sStr2 = ""
  For Each ZZ In Range("c2:c111")
If Not IsError(ZZ) Then
   If Range("Q26").Value = 1 And flag = True Then
      M = Round(ZZ - ZZ.Offset(, 26), 2)
      If M >= ZZ.Offset(, 2) Then
      If sStr <> "" Then sStr = sStr & Chr(10)
      sStr = sStr & "" & Cells(ZZ.Row, 2).Value & "=====> " _
               & Round(ZZ - ZZ.Offset(, 26), 2)

      End If
      If M <= -ZZ.Offset(, 2) Then
      If sStr2 <> "" Then sStr2 = sStr2 & Chr(10)
      sStr2 = sStr2 & "" & Cells(ZZ.Row, 2).Value & "=====> " _
               & Round(ZZ - ZZ.Offset(, 26), 2)

      End If
   End If
End If
  Next
  If sStr <> "" Then
MsgBoxTest 0, "", "", sStr, 0, 2500
  End If
  If sStr2 <> "" Then
MsgBoxTest 0, "", "", sStr2, 0, 2500
  End If

3.另外一個方法用" FindWindow " 來關閉這訊息窗，不過找不到這訊息窗?[attach]15829[/attach]
http://hi.baidu.com/zzllrr/item/9a561a634853bc90c4d2493d

作者: luhpro 時間: 2013-8-22 23:56

本帖最後由 luhpro 於 2013-8-22 23:58 編輯

1.之前的問題，經再測試無法自動關掉訊息窗
是因為跑下面的程式,不知有無辦法改善?
好像只要有在跑ti ...
t8899 發表於 2013-8-22 04:35

1. 這我也不知道,不過據我所知 Excel VBA 畢竟不是單純的 VB 系統,
在某些情形下還是會發生某些我們覺得不太能理解的狀況.

最簡單的例子是若某時間有開了兩個 Excel 檔案,其中一個有 Excel VBA 程式的檔案,
有可能會干擾到另一個沒有 VBA 程式檔案的編輯作業.(尤其是 Worksheet_Change 與 Worksheet_SelectionChange 程序最易發生此狀況)

依你的敘述看起來,
它可能不能同時執行太多的 Application.OnTime 程式.(疑似會有相互干擾的情形出現)

當然這個就是很內部的東西了,
當 Excel VBA 每呼叫一次 Application.OnTime 程式,
是否就會配置一個程序空間來存放該程式運作中的變數,
直到該程式結束才釋放掉該空間?
亦或是只要是執行該程式,
就都是使用同一個程序空間裡的變數呢?
若是後者那出現你說的情形應該就不意外了.

而若真要是這個問題也是有方法解決的啦,
只要 "每個" 呼叫的程式都不同就不會互相干擾了,
亦即要確保同一時間在跑的 OnTime 程式都是在不同程式區塊中即可.
可不可行我不知道你可以試試看.

2. 與上方的定義內容一一比對即可知道錯誤出在哪裡了:
你的呼叫程式為 :

MsgBoxTest 0, "", "", sStr, 0, 2500

而其定義則為 :
Private Declare Function MsgBoxTest Lib "user32" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _                <=== 上面的 0 , OK
ByVal lpText As String, _             <=== 上面的 "", OK
ByVal lpCaption As String, _       <=== 上面的 "", OK
ByVal wType As VbMsgBoxStyle, _ <=== 上面的 sStr, 錯誤出在此
ByVal wlange As Long, _             <=== 上面的 0, OK
ByVal dwTimeout As Long _       <=== 上面的 2500, OK
                        ) As Long

至於 VbMsgBoxStyle?
在 http://www.codeproject.com/Articles/7914/MessageBoxTimeout-API
上看到 : uiFlags = MB_YESNO|MB_SETFOREGROUND|MB_SYSTEMMODAL|MB_ICONINFORMATION
且
http://www.pinvoke.net/default.aspx/user32/MessageBoxTimeout.html?diff=y
上看到該參數可定義為 ByVal MessageBoxOptions As Long
所以至少那應該是個數字而非文字才是,
而在 http://baike.baidu.com/view/5079352.htm
這裡有詳細說明各個數值的定義.

至於 sStr 則應放在 lpText As String 上.

綜上你可以試試 :

MsgBoxTest 0, sStr, "提示訊息", 0, 0, 2500

3. FindWindow 要先知道該視窗的 handle 或是足資辨識該視窗的資料才能找到該視窗,
這個我要再查查看是否有可能解決.

作者: t8899 時間: 2013-8-23 09:13

1綜上你可以試試 :
MsgBoxTest 0, sStr, "提示訊息", 0, 0, 2500.
luhpro 發表於 2013-8-22 23:56

謝謝已經解決
MsgBoxTest 會自動關閉視窗,應該是MsgBoxTest獨立在跑
有兩個小缺點
1有時提示時無法在最前景??
2提示時，會出現漏斗狀，沒辦法做其他事情，但沒差，只有幾秒而已

作者: luhpro 時間: 2013-8-26 22:54

謝謝已經解決
MsgBoxTest 會自動關閉視窗,應該是MsgBoxTest獨立在跑
有兩個小缺點
1有時提示時無法在最前景??
2提示時，會出現漏斗狀，沒辦法做其他事情，但沒差，只有幾秒而已
t8899 發表於 2013-8-23 09:13

1. 本來若你用的是 MsgBox 函數, 則在 MsgBox 函數的說明中有寫到 :
語法
MsgBox(prompt[, buttons] [, title] [, helpfile, context])
buttons 引數的設定有以下幾個：
其中有 :
VbMsgBoxSetForeground 65536 指定訊息方塊視窗作為前景視窗。
亦即你程式只要在第二個參數加上 + VbMsgBoxSetForeground 即可讓此訊息顯示在最上層.
但如今你用的是另一個Windows API函數,
這個函數我找不到哪裡有較詳細的說明,
所以就需要你自己測試看看該函數是否有這個功能了.

2. 同上,這個問題我也不知道如何處理.

作者: t8899 時間: 2013-8-27 05:58

本帖最後由 t8899 於 2013-8-27 06:11 編輯

1. 本來若你用的是 MsgBox 函數, 則在 MsgBox 函數的說明中有寫到 :
語法
MsgBox(prompt[, buttons] [ ...
luhpro 發表於 2013-8-26 22:54

找到了 ====> vbSystemModal 應用程式強制回應：使用者必須先回應此訊息方塊，才能在目前的應用程式中繼續工作
沒加vbSystemModal,訊息視窗出現時，點其他軟體為active，excel的訊息視窗就無法在最前面
意即不知道有此訊息..
MsgBoxTest 0, sStr, "提示訊息",vbSystemModal, 0, 2500 ====>這是OK
MsgBoxTest 這個API (應該已包含MSGBOX的所有功能,不然vbSystemModal無法作用才對?)

VbMsgBoxSetForeground 65536 指定訊息方塊視窗作為前景視窗，應該也可以掛在vbSystemModal 同等位置
MsgBoxTest 0, sStr, "提示訊息",VbMsgBoxSetForeground , 0, 2500
測試了一下沒作用

作者: t8899 時間: 2013-8-27 06:14

p.s. (65536 無法放在VbMsgBoxSetForeground 後面，語法錯誤)

作者: luhpro 時間: 2013-8-27 22:56

p.s. (65536 無法放在VbMsgBoxSetForeground 後面，語法錯誤)
t8899 發表於 2013-8-27 06:14

65536 放在 VbMsgBoxSetForeground 後面?
當然會發生錯誤啦.

說明中的內文是 :

常數值說明
====================================================
VbMsgBoxSetForeground 65536 指定訊息方塊視窗作為前景視窗。

它的意思是說 :
在 Excel VBA 中, 已經有定義了 VbMsgBoxSetForeground 這個常數的值為 65536,
你在 MsgBox 函數的 buttons 引數的位置上,
可以使用 VbMsgBoxSetForeground 這個常數或是用 65536 這個值(任取其中之一),
來設定這次使用 MsgBox 函數指定其訊息方塊視窗作為前景視窗.

你也可以參考 MsgBox 的範例得知其使用方式:
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
參照範例可得出你可以使用 :
MsgBox sStr, vbYesNo + VbMsgBoxSetForeground , "提示訊息"
或是
MsgBox sStr, 4 + 65536 , "提示訊息" (左式也等同 MsgBox sStr, 65540 , "提示訊息")
上兩式的結果是相同的.

不過 MsgBox 函數可以使用的常數不一定就適用 MsgBoxTest (在 Windows API 中它其實應該是 MessageBoxTimeoutA),
這要看在 Windows API 與 Excel VBA 中,
MessageBoxTimeoutA 函數是否有實做出該引數為 VbMsgBoxSetForeground 值時所應該出現的效果,
最簡單的方法就是套用進程式中,
然後實際跑跑看就知道有沒有此功能了.

作者: t8899 時間: 2013-8-28 06:49

65536 放在 VbMsgBoxSetForeground 後面?
當然會發生錯誤啦.
說明中的內文是 :
常數 ...
luhpro 發表於 2013-8-27 22:56

Sub eighty()
Sheets("Sheet1").Select
Range("a65536").End(xlUp).Offset(1).Select
      Application.SendKeys "{Home}", True
      Application.SendKeys "^{;}", True
      Application.SendKeys "{enter}", True
Sheets("Sheet1").Select
Range("B2:N2").Select '=====>為何多加此行，造成上面的執行不正確,拿掉則正確????[attach]15865[/attach]

End Sub

作者: c_c_lai 時間: 2013-8-28 07:28

回復 63# t8899

Sub eighty()
With Sheets("Sheet1")
.Select
.Range("a65536").End(xlUp).Offset(1).Select
Application.SendKeys "{Home}", True
Application.SendKeys "^{;}", True
Application.SendKeys "{enter}", True
.Range("B2:N2").Select
End With
End Sub

複製代碼

試試看！

作者: t8899 時間: 2013-8-28 20:52

回復 t8899 試試看！
c_c_lai 發表於 2013-8-28 07:28

無效..................

作者: stillfish00 時間: 2013-8-29 13:53

回復 65# t8899

Sub eighty()
With Sheets("Sheet1")
.Select
.Range("a65536").End(xlUp).Offset(1).Select
Application.SendKeys "{Home}", True
Application.SendKeys "^{;}", True
Application.SendKeys "{enter}", True
DoEvents
.Range("B2:N2").Select
End With
End Sub

複製代碼

作者: t8899 時間: 2013-8-29 18:09

回復 t8899
stillfish00 發表於 2013-8-29 13:53

這個可以，可能執行速度太快的關係??

作者: luhpro 時間: 2013-8-29 23:23

Sub eighty()
...
Range("B2:N2").Select '=====>為何多加此行，造成上面的執行不正確,拿掉則正確????
t8899 發表於 2013-8-28 06:49

這行是我加的嗎?
我沒有印象有加這行啊?

現在我已經很少用 Select 指令了,
除非確有其必要性,(例如需要用到 Selection 做指令主體, 或是需要變更Excel檔案焦點到另一個主體上)
否則這行除了浪費系統資源外,
並沒有什麼其他好處,
很多情形下其實是根本不需用到 Select 指令就可以達到我們的目的.

不過這個指令在 Debug 程式時倒是滿好用的,
例如想 Copy 時,
可以先不真的 Copy 而可以使用 F8 單步模式追蹤,
執行 Copy 前先在即時視窗用 Select 來確認欲運作的標的是否正確.

因為你的 Sample 檔不能判斷該行用處在哪及拿掉是否會出問題,
所以你只能自行測試或判斷,
你若是確定加了該指令對程式結果沒什麼用處的話,
那就乾脆直接刪掉該行吧. (你也可以先在該行前面加個 ' 把它變成註解文字, 該行就不會執行了, 反之就又會執行了)

作者: t8899 時間: 2013-8-30 07:25

這行是我加的嗎?
我沒有印象有加這行啊?

luhpro 發表於 2013-8-29 23:23

抱歉，這是我另外問的.....不是你加的
答案可用 DoEvents 解決 (可能cpu 跑太快了)

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