ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¿é¤J[½s¸¹]¦Û°ÊÅã¥Ü[©m¦W],¬dµL¸ê®Æ®É,¦p¦ó²MªÅÀx¦s®æ

[µo°Ý] ¿é¤J[½s¸¹]¦Û°ÊÅã¥Ü[©m¦W],¬dµL¸ê®Æ®É,¦p¦ó²MªÅÀx¦s®æ

¥»©«³Ì«á¥Ñ dou10801 ©ó 2023-2-7 22:43 ½s¿è

¿é¤J[½s¸¹]¦Û°ÊÅã¥Ü[©m¦W],¬dµL¸ê®Æ®É,¦p¦ó²MªÅÀx¦s®æ,·P®¦.


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 = [ºK­n!a:a].Find(Target.Value, Lookat:=xlWhole)
     If xF Is Nothing Then
        MsgBox "§ä¤£¨ì!"
        ¤u§@ªí2.Cells(Target.Row, 3) = ""
        '¤u§@ªí2.Cells(Target.Row, 2) = ""  '³o¦æµL§@¥Î
        Exit Sub
     Else
        m1 = xF(2, 1)
        ¤u§@ªí4.Cells(m1, 2).Copy ¤u§@ªí2.Cells(Target.Row, 3)
     End If
    Application.ScreenUpdating = True
     Set xF = Nothing
End Sub

¾P°â²Î­p22.rar (17.74 KB)

§ù¤p¥­

¦^´_ 1# dou10801


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç¸Õ²z¸Ñ»Ý¨D,«Øij¦p¤U:

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 'ÅýIJµo¥¢®Ä¤~¤£·|³sÄòIJµo
     Set xF = [ºK­n!a:a].Find(Target.Value, Lookat:=xlWhole)
     If xF Is Nothing Then
        MsgBox "§ä¤£¨ì!"
        ¤u§@ªí2.Cells(Target.Row, 3) = ""
        ¤u§@ªí2.Cells(Target.Row, 2) = ""
        'Exit Sub
     Else
        m1 = xF(2, 1)
        ¤u§@ªí4.Cells(m1, 2).Copy ¤u§@ªí2.Cells(Target.Row, 3)
     End If
    Application.ScreenUpdating = True
     Set xF = Nothing
     Application.EnableEvents = True '³Ì«á¤~ÅýIJµo«ì´_
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483 ·P®¦,VBAÁÙ¦³«Ü¦h¤p²Ó¸`­n¾Ç²ß.
§ù¤p¥­

TOP

¦^´_ 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 [ºK­n$a1:B] where ¥N¸¹ = '" & Format(Target.Value, "000") & "'"
Set rs = cn.Execute(Sql)
Application.EnableEvents = False
If rs.getrows(, , "ct")(0, 0) = 1 Then  '°»¿ù®É ®e©ö¥¢®Ä
    Set rs = cn.Execute("select * from [ºK­n$a1:B] where ¥N¸¹ = '" & Format(Target.Value, "000") & "'")
    Cells(Target.Row, 2).CopyFromRecordset rs '.getrows '(,,array("¥N¸¹","©m¦W"))
Else
    Target.Value = ""
End If
Application.EnableEvents = True
cn.Close
Set cn = Nothing
End Sub

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD