[發問] 當某個儲存格數值&gt;50,則立即記錄指定欄位的值(求VBA)

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

2^#

發表於 2017-2-18 22:56 | 顯示全部帖子

試試看!
下列VBA放到Sheet1("Sheet2")的vba中,
不要放Module1中
yen956 發表於 2017-2-18 12:33

感謝大大
目前copy過來的是公式
而不是值

可以copy值過來嗎

感謝再感謝

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

3^#

發表於 2017-2-19 20:05 | 顯示全部帖子

試試看!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, LastR As Integer, sh3 As Object
Set sh3 = Sheets("Sheet3")
Set Rng = [C13]    '設定 [C13] 為 Worksheet_Change觸動範圍
LastR = sh3.[A65536].End(xlUp).Row + 1    '取得欄A最下面非空白格的下一格的列號
If Not Intersect(Target, Rng) Is Nothing And Rng.Value > 50 Then
      [A17].Resize(1, 4).Select
      [A17].Resize(1, 4).Copy sh3.Cells(LastR, 1)
End If
End Sub
yen956 發表於 2017-2-18 12:33

~~~~~~~~~~~~~~~~~~~~~~~
感謝 yen956 大大的熱情回覆

我是想要將A17:19 複製到SHEET3

因為我執行大大VBA 後
他會將A17:19 用公式的方式 COPY 到 SHEET3 去

可以將COPY 呈現出我要的方式嗎??

再次感謝 yen956 大大熱情的幫忙
謝謝你

小弟將我的檔案附上請大大在幫我看看

Book2----.rar (8.07 KB)

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

4^#

發表於 2017-2-21 17:39 | 顯示全部帖子

本帖最後由 peter95 於 2017-2-21 17:47 編輯

回復 6# yen956

再次謝謝 yen956大大

目前測試已經可以將資料紀錄下來
請問大大
若一樣是以C13>50 為例
當C13>50 時 一樣將 A17:D17 的資料
可否用 觸發功能 發MAIL或

給我呢??

非常感謝大大的幫忙
謝謝

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

5^#

發表於 2017-2-21 21:43 | 顯示全部帖子

回復  peter95
Private Sub Worksheet_Calculate()
Dim Rng As Range, LastR As Integer, sh3 As Object
Set sh3 = Sheets("Sheet3")
LastR = sh3.[A65536].End(xlUp).Row + 1    '取得 "Sheet3" 欄A最下面非空白格的下一格的列號
If [C13] > 50 Then
      [A17].Resize(1, 4).Copy
      sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
End If
End Sub
yen956 發表於 2017-2-20 18:25

可以將上列VBA 延後二分鐘執行嗎???

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

6^#

發表於 2017-2-22 20:18 | 顯示全部帖子

本帖最後由 peter95 於 2017-2-22 20:19 編輯

抱歉, E-mail 我不會, 可另發文請教其他大大,
每2分鐘則可借用 Hsieh版大的 onTime, 如下:

Worksheet_C ...
yen956 發表於 2017-2-22 20:06

感謝yen956大大

我的意思是當我開啟我的EXCEL檔時
延後2分鐘才去執行你下列的VBA
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Worksheet_Calculate()
Dim Rng As Range, LastR As Integer, sh3 As Object
Set sh3 = Sheets("Sheet3")
LastR = sh3.[A65536].End(xlUp).Row + 1    '取得 "Sheet3" 欄A最下面非空白格的下一格的列號
If [C13] > 50 Then
      [A17].Resize(1, 4).Copy
      sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
而不是每2分鐘紀錄一次

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

7^#

發表於 2017-2-22 22:38 | 顯示全部帖子

本帖最後由 peter95 於 2017-2-22 22:39 編輯

回復 11# yen956

謝謝 yen956大大熱情的幫忙
真的很感謝你

小的的意思是
當我開啟我的EXCEL檔時
你的VBA 就開始檢查 [C13]
但剛開啟EXCEL檔時
資料量是完全沒有進來的

所以 [C13] 那個儲存格會顯示 #N/A 就是沒資料
則VBA 就會顯示錯誤

不曉得有無辦法將此情形克服
~~~~~~~~~~~~~~~~~~~~~~~~~

學習學習一直學習

帖子: 49
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: win7
軟體版本: office2001
閱讀權限: 20
性別: 男
註冊時間: 2012-4-10
最後登錄: 2024-8-9

8^#

發表於 2017-3-3 18:27 | 顯示全部帖子

每2分鐘則可借用 Hsieh版大的 onTime, 如下:

Worksheet_Calculate 刪除, 改用 Hsieh版大的 onTime
請放在 Module
http://forum.twbts.com/thread-19283-1-2.html
'從早上8點到下午5點每2分鐘執行 "Copy_test" 1次
Sub OnTime_test()
Dim t
For t = TimeValue("08:00:00") To TimeValue("17:00:00") Step TimeValue("00:02:00")
   Application.OnTime t, "Copy_test"
Next
End Sub

Sub Copy_TEST()
Dim LastR As Integer, sh2 As Object, sh3 As Object
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
LastR = sh3.[A65536].End(xlUp).Row + 1    '取得 "Sheet3" 欄A最下面非空白格的下一格的列號
If sh2.[C13] > 50 Then
      sh2.[A17].Resize(1, 4).Copy
      sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
End If
End Sub
yen956 發表於 2017-2-22 20:06

請問大大是放在模組嗎??

小弟有放但是沒有執行COPY
請問我可以修正哪裡
感謝

學習學習一直學習