返回列表下一主題上一主題發帖

[發問] VBA 編寫複製進入死循環

dnadark

小學生 Rank: 1

帖子: 10
主題: 3
精華: 0
積分: 15
點名: 0
作業系統: windows7
軟體版本: 2012
閱讀權限: 10
註冊時間: 2015-1-1
最後登錄: 2021-5-26

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-4-27 14:54 | 只看該作者

[發問] VBA 編寫複製進入死循環

本帖最後由 dnadark 於 2015-4-27 14:57 編輯

您好：

附件除A欄之外都將儲存格鎖定進行保護
唯A欄值大於或小於B欄時，會將A欄儲存格的資料複製到C欄
並鎖住A欄該儲存格，再保護工作表，
但是複製時不斷陷入死循環，請問有沒有其他的寫法可以改善？

If Cells(Target.Row, 1) <> "" And Cells(Target.Row, 1) > Cells(Target.Row, 2) * 2 Or Cells(Target.Row, 1) <> "" And Cells(Target.Row, 1) < Cells(Target.Row, 2) * 0.5 Then
ActiveSheet.Unprotect
Cells(Target.Row, 3) = Cells(Target.Row, 1)---->卡住
Cells(Target.Row, 1).Locked = True
ActiveSheet.Protect
End If

cats.jpg (27.42 KB)

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2015-4-27 16:37 | 只看該作者

回復 1# dnadark

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERR_HANDLE
If Cells(Target.Row, 1) <> "" And Cells(Target.Row, 1) > Cells(Target.Row, 2) * 2 Or Cells(Target.Row, 1) <> "" And Cells(Target.Row, 1) < Cells(Target.Row, 2) * 0.5 Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Cells(Target.Row, 3) = Cells(Target.Row, 1)
Cells(Target.Row, 1).Locked = True
ActiveSheet.Protect
End If
BEFORE_EXIT:
Application.EnableEvents = True
Exit Sub
ERR_HANDLE:
MsgBox Err.Description, vbCritical, "ERROR:" & Err.Number
Resume BEFORE_EXIT
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

dnadark

小學生 Rank: 1

帖子: 10
主題: 3
精華: 0
積分: 15
點名: 0
作業系統: windows7
軟體版本: 2012
閱讀權限: 10
註冊時間: 2015-1-1
最後登錄: 2021-5-26

3^#

發表於 2015-4-27 17:40 | 只看該作者

您好：
      謝謝！已經試成功了，但是該巨集完了之後其實後面還有寫其他巨集，
如附件，剛剛的是當不符合時的狀況，但是符合條件時會將符合的列的資料鎖住
並將其他的列也全鎖住，只開放下一列供寫入
但是加下您所提供的資料後，後續都無效，請問要怎麼接呢？

   If Cells(Target.Row, 1) <> "" And Cells(Target.Row, 3) <> "" Then
ActiveSheet.Unprotect
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Locked = True
Range(Cells(Target.Row + 2, 1), Cells(1048576, 3)).Locked = True
Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 3)).Locked = False
   ActiveSheet.Protect
Cells(Target.Row + 1, 1).Select
end if

cats1.jpg (53.78 KB)