標題: [發問] 輸入[編號]自動顯示[姓名],查無資料時,如何清空儲存格 [打印本頁]

---

作者: dou10801    時間: 2023-2-7 22:34     標題: 輸入[編號]自動顯示[姓名],查無資料時,如何清空儲存格

本帖最後由 dou10801 於 2023-2-7 22:43 編輯

輸入[編號]自動顯示[姓名],查無資料時,如何清空儲存格,感恩.


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xF As Range
    Application.ScreenUpdating = False
    If Target.Count > 2 Or Target.Column <> 2 Then End   
     Set xF = [摘要!a:a].Find(Target.Value, Lookat:=xlWhole)
     If xF Is Nothing Then
        MsgBox "找不到!"
        工作表2.Cells(Target.Row, 3) = ""
        '工作表2.Cells(Target.Row, 2) = ""  '這行無作用
        Exit Sub
     Else
        m1 = xF(2, 1)
        工作表4.Cells(m1, 2).Copy 工作表2.Cells(Target.Row, 3)
     End If
    Application.ScreenUpdating = True
     Set xF = Nothing
End Sub

---

作者: Andy2483    時間: 2023-2-8 15:17

回復 1# dou10801


    謝謝前輩發表此主題與範例
後學試理解需求,建議如下:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xF As Range
    Application.ScreenUpdating = False
    If Target.Count > 2 Or Target.Column <> 2 Then End
     Application.EnableEvents = False '讓觸發失效才不會連續觸發
     Set xF = [摘要!a:a].Find(Target.Value, Lookat:=xlWhole)
     If xF Is Nothing Then
        MsgBox "找不到!"
        工作表2.Cells(Target.Row, 3) = ""
        工作表2.Cells(Target.Row, 2) = ""
        'Exit Sub
     Else
        m1 = xF(2, 1)
        工作表4.Cells(m1, 2).Copy 工作表2.Cells(Target.Row, 3)
     End If
    Application.ScreenUpdating = True
     Set xF = Nothing
     Application.EnableEvents = True '最後才讓觸發恢復
End Sub

---

作者: dou10801    時間: 2023-2-9 09:46

回復 2# Andy2483 感恩,VBA還有很多小細節要學習.

---

作者: singo1232001    時間: 2023-2-9 12:38

回復 1# dou10801


    Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 2 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If IsNumeric(Target.Value) = fasle Then Exit Sub
Set cn = CreateObject("adodb.connection")
Select Case Application.Version
Case Is < 12: cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; Data Source=" & ThisWorkbook.FullName
Case Else: cn.Open = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; Data Source=" & ThisWorkbook.FullName
End Select

Sql = "select count(*) as ct from [摘要$a1:B] where 代號 = '" & Format(Target.Value, "000") & "'"
Set rs = cn.Execute(Sql)
Application.EnableEvents = False
If rs.getrows(, , "ct")(0, 0) = 1 Then  '偵錯時 容易失效
    Set rs = cn.Execute("select * from [摘要$a1:B] where 代號 = '" & Format(Target.Value, "000") & "'")
    Cells(Target.Row, 2).CopyFromRecordset rs '.getrows '(,,array("代號","姓名"))
Else
    Target.Value = ""
End If
Application.EnableEvents = True
cn.Close
Set cn = Nothing
End Sub

---

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