返回列表 上一主題 發帖

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

dou10801

帖子
146 
主題
41 
精華
0 
積分
229 
點名
289  
作業系統
WIN10 
軟體版本
2010 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2011-6-21 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

銷售統計22.rar (17.74 KB)

收藏 分享
杜小平

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
2#
發表於 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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

dou10801

帖子
146 
主題
41 
精華
0 
積分
229 
點名
289  
作業系統
WIN10 
軟體版本
2010 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2011-6-21 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
3#
發表於 2023-2-9 09:46 | 只看該作者
回復 2# Andy2483 感恩,VBA還有很多小細節要學習.
杜小平

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

帖子
354 
主題
5 
精華
0 
積分
387 
點名
0  
作業系統
windows7 
軟體版本
vba,vb,excel2007 
閱讀權限
20 
性別
男 
註冊時間
2017-1-8 
最後登錄
2024-8-2 

論壇榮譽勳章論壇贊助勳章
4#
發表於 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

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題