[µo°Ý] Àx¦s®æ¤º¦³¨ç¼Æ¡A¦ý·Q­n¤â°Ê¿é¤J®É·|Åý­ì¦³¨ç¼Æ¤£¨£

j88141

Àx¦s®æ¤º¦³¨ç¼Æ¡A¦ý·Q­n¤â°Ê¿é¤J®É·|Åý­ì¦³¨ç¼Æ¤£¨£
ÁÙ¦³¥æ¤e¤ñ¹ïªº°ÝÃD
½Ð°Ý­n«ç»ò§ï¤~¦n
§Æ±æ¥ÎVBA(¨ä¥L¤èªk¤]¥i¥H)
·íµM¯à¸Ñ¨M³Ì¦n
ªþ¹Ï»¡©ú¡A§Æ±æ¤j®a·|¤ñ¸û²M·¡

        ¤u§@ªí 1                                                                          ¤u§@ªí2                              

¤U¸ü (46.94 KB)

2014-4-4 15:15

      

¤U¸ü (51.69 KB)

2014-4-4 15:15

     

                 ¤u§@ªí3

¤U¸ü (79.31 KB)

2014-4-4 15:24

¬¡­¶Ã¯1.rar (12.74 KB)

¤U¸ü¦¸¼Æ: 6

2014-4-4 15:25

»k¥ú°j¯T

¦^´_ 1# j88141



1.·s¼W¡i¤u§@ªí¡j¦WºÙ§ó¬°¡i¸ê®Æ®w¡j

2.½Ð¨Ï¥Î¡i¦WºÙ©w¸q¡j¡A©w¸q¡i¥N¸¹¡j¡iºØÃþ¡j¡i©m¦W¡j
¡@¡@¡i¥N¸¹¡j°Ñ·Óªº¤½¦¡¡G=OFFSET(¸ê®Æ®w!$A$1,,,COUNTA(¸ê®Æ®w!$AA),)
¡@¡@¡iºØÃþ¡j°Ñ·Óªº¤½¦¡¡G=OFFSET(¸ê®Æ®w!$B$1,,,COUNTA(¸ê®Æ®w!$BB),)
¡@¡@¡i©m¦W¡j°Ñ·Óªº¤½¦¡¡G=OFFSET(¸ê®Æ®w!$C$1,,,COUNTA(¸ê®Æ®w!$CC),)

******¡@¥H¤W¿é¤J§¹¦¨«á¡A´Nºâ¦³¼W¥[µ§¼Æ¸ê®Æ¡A¡i¦WºÙ©w¸q¡j¤]·|¦Û°Ê§ó·s¸ê®Æ®w

3.¦A¨Ï¥Î¡i¸ê®ÆÅçÃÒ¡j=> ²M³æ
¡@¡@¡i¨Ó·½¡j¤½¦¡¡G=¥N¸¹
¡@¡@¡i¨Ó·½¡j¤½¦¡¡G=ºØÃþ
¡@¡@¡i¨Ó·½¡j¤½¦¡¡G=©m¦W

4.¸Ô±¡½Ð¬Ýªþ¥ó(¥Î§Aµ¹ªºªí®æ­×§ïªº)

luhpro

Àx¦s®æ¤º¦³¨ç¼Æ¡A¦ý·Q­n¤â°Ê¿é¤J®É·|Åý­ì¦³¨ç¼Æ¤£¨£
ÁÙ¦³¥æ¤e¤ñ¹ïªº°ÝÃD
½Ð°Ý­n«ç»ò§ï¤~¦n
§Æ±æ¥ÎVBA(¨ä ...
j88141 µoªí©ó 2014-4-4 15:21

Module1 :

1. Public v11, v12, v21, v22

½Æ»s¥N½X

Workbook :

1. Private Sub Workbook_Open()
   
2.   Dim vA
   
3.   Dim rSou As Range, rTar As Range
   
4.   
   
5.   Set v11 = CreateObject("Scripting.Dictionary")
   
6.   Set v12 = CreateObject("Scripting.Dictionary")
   
7.   Set v21 = CreateObject("Scripting.Dictionary")
   
8.   Set v22 = CreateObject("Scripting.Dictionary")
   
9.   
   
10.   Set rSou = Sheets("¤u§@ªí1").Range("A:A").SpecialCells(xlCellTypeConstants)
    
11.   For Each rTar In rSou
    
12.     If rTar <> "" And Left(rTar, 2) <> "¬P´Á" Then v11(CStr(rTar)) = 1
    
13.   Next
    
14.   
    
15.   Set rSou = Sheets("¤u§@ªí1").Range("C:C").SpecialCells(xlCellTypeConstants)
    
16.   For Each rTar In rSou
    
17.     If rTar <> "" And Left(rTar, 2) <> "¬P´Á" Then v12(CStr(rTar)) = 1
    
18.   Next
    
19. 
    
20.   Set rSou = Sheets("¤u§@ªí2").Range("A:A").SpecialCells(xlCellTypeConstants)
    
21.   For Each rTar In rSou
    
22.     If rTar <> "¥N¸¹" Then
    
23.       v21(CStr(rTar)) = rTar.Offset(, 1)
    
24.       v22(CStr(rTar)) = rTar.Offset(, 2)
    
25.     End If
    
26.   Next
    
27. End Sub

½Æ»s¥N½X

¤u§@ªí3 :

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim bNFind As Boolean
   
3.   
   
4.   With Target
   
5.     If .Count = 1 Then
   
6.       If .Row = 1 Then ' A1 ©Î B1
   
7.         bNFind = True
   
8.         Select Case .Column
   
9.         
   
10.         Case 1
    
11.           If v11.exists(CStr(v22(CStr(Target)))) Then
    
12.             .Offset(1) = v21(CStr(Target))
    
13.             .Offset(2) = v22(CStr(Target))
    
14.             bNFind = False
    
15.           End If
    
16. 
    
17.         
    
18.         Case 2
    
19.           If v12.exists(CStr(v22(CStr(Target)))) Then
    
20.             .Offset(1) = v21(CStr(Target))
    
21.             .Offset(2) = v22(CStr(Target))
    
22.             bNFind = False
    
23.           End If
    
24.         
    
25.         Case Else
    
26.            bNFind = False
    
27.            
    
28.         End Select
    
29.         
    
30.         If bNFind Then
    
31.           MsgBox v22(CStr(Target)) & " ¨S¦³±Æ¯Z"
    
32.           .Resize(3).ClearContents
    
33.           .Select
    
34.         End If
    
35.       End If
    
36.     End If
    
37.   End With
    
38. End Sub

½Æ»s¥N½X

¬¡­¶Ã¯1-a.zip (19.91 KB)

¤U¸ü¦¸¼Æ: 3

2014-10-14 23:54

GBKEE

¦^´_ 3# luhpro
½Ð°Ñ¦Ò¤@¤U

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim bNFind As Range
   
4.     With Target
   
5.         If .Count = 1 Then
   
6.             If .Row = 1 And .Column <= 7 Then  ' A1 ©Î B1(¬P´Á¤@ ¨ì ¬P´Á¤é)
   
7.                 .Range("A2").Resize(2) = ""
   
8.                 .Range("A3").Validation.Delete
   
9.                 If .Value = "" Then Exit Sub
   
10.                 Application.EnableEvents = False
    
11.                 Set bNFind = Sheets("¤u§@ªí2").Range("A:A").Find(.Value, LookAT:=xlWhole)
    
12.                 If Not bNFind Is Nothing Then
    
13.                     .Offset(1) = bNFind.Range("B1")
    
14.                     If ±Æ¯Z(bNFind.Range("C1"), Target) Then .Offset(2) = bNFind.Range("C1") & vbLf & "¨S¦³±Æ¯Z"
    
15.                 End If
    
16.                 Application.EnableEvents = True
    
17.             End If
    
18.         End If
    
19.     End With
    
20. End Sub
    
21. Private Function ±Æ¯Z(ByVal T1 As Range, T2 As Range) As Boolean
    
22.     Dim bNFind As Range, S As String
    
23.     With Sheets("¤u§@ªí1")
    
24.         Set bNFind = .Columns(T2.Column).Find(T1, LookAT:=xlWhole)
    
25.         If Not bNFind Is Nothing Then
    
26.             For Each bNFind In .Columns(T2.Column).SpecialCells(xlCellTypeConstants)
    
27.                 If bNFind.Row > 1 And bNFind <> "" Then
    
28.                     S = IIf(S <> "", S & "," & bNFind, bNFind)
    
29.                 End If
    
30.             Next
    
31.         Else
    
32.            ±Æ¯Z = True
    
33.         End If
    
34.         With T2.Range("A3")
    
35.             If Not ±Æ¯Z Then
    
36.                 .Validation.Add Type:=xlValidateList, Formula1:=S
    
37.                 .Value = T1
    
38.             End If
    
39.         End With
    
40.     End With
    
41. End Function

½Æ»s¥N½X