[µo°Ý] ¥ÎVBA®ÚÕu¡§©m¦W¡¨©M¡§¨­¥÷证号码¡¨¡A¶ñ¥R«H®§

Farnsworth

¥ÎVBA¤ñ对¡A®ÚÕu¡§©m¦W¡¨©M¡¨¨­¥÷证号码¡§¤ñ对¡§°ò础¡¨ªí©M¡§©ú细¡¨ªí¡AµM¦Z¶ñ写¡§°ò础¡¨ªí¡§I¦C----T¦C¡¨¡C¡]见图©Mªþ¥ó¡^

¤U¸ü (176.48 KB)

2017-3-28 15:19

??«O???¨D§U¥Ü¨Ò.zip (26.88 KB)

学员«O险汇总¨D§U¥Ü¨Ò
¤U¸ü¦¸¼Æ: 10

2017-3-28 15:19

­ã´£³¡ªL

1. Sub TEST()
   
2. Dim R&, xR As Range, xF As Range, xE As Range, j%, Jm%, k%, Km%
   
3. R = Cells(Rows.Count, 2).End(xlUp).Row: If R < 3 Then Exit Sub
   
4. Range("A3:I" & R).Interior.ColorIndex = xlNone
   
5. 
   
6. For Each xR In Range("B3:B" & R)
   
7.     If xR = "" Then GoTo 101
   
8.     Set xF = Sheets("Sheet1").[B:B].Find(xR, lookat:=xlWhole)
   
9.     If xF Is Nothing Then xR.Interior.ColorIndex = 3: GoTo 101 '§ä¤£¨ì¨­¥÷ÃÒ¸¹
   
10.     If xF(1, 0) <> xR(1, 0) Then xR(1, 0).Interior.ColorIndex = 3: GoTo 101 'ÃÒ¸¹©m¦W¤£²Å
    
11.    
    
12.     If xF(1, 21) = "µ²·~" Then GoTo 101
    
13.    
    
14.     For j = 3 To 6
    
15.         If Not IsDate(xR(1, j)) Then GoTo 102
    
16.         Jm = 0: Km = 0
    
17.         For k = 1 To 3
    
18.             Set xE = xF(1, 7 + (j - 3) * 3 + k)
    
19.             If xR(1, j) = xE Then Jm = 1
    
20.             If xE <> "" Then Km = Km + 1
    
21.             If Jm = 0 And xE = "" Then xE = xR(1, j): Exit For
    
22.         Next k
    
23.         If Km = 3 Then xR(1, j).Interior.ColorIndex = 6: GoTo 102
    
24.         If Jm = 1 Then xR(1, j).Interior.ColorIndex = 3
    
25. 102: Next j
    
26.    
    
27. 101: Next
    
28. End Sub

½Æ»s¥N½X

Xl0000143(¨­¥÷¤ñ¹ï)_v2.rar (27.8 KB)

¤U¸ü¦¸¼Æ: 13

2017-4-8 21:32

³o¬Oª©¥»2, ¦Û¦æ¥h¬ã¨s, ¨S®É¶¡¦A¸ò©«!

Farnsworth

¦^´_ 5# ­ã´£³¡ªL


    «D±`·P谢¡A¨ä实§Ú¤]¤@ª½¦b§V¤O学习VBA¡A§Æ±æ¦³时间¯à

Farnsworth

«D±`·P谢¡A§Ú¤]¦b§V¤O学员VBA¡A§Æ±æ±z¦³时间¯à给§Ú

­ã´£³¡ªL

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim IdRng As Range, xF As Range, xR As Range, C%, j%, Jm%, Km%
   
3. With Target
   
4.      If .Count > 1 Then Exit Sub
   
5.      C = .Column
   
6.      If .Row < 3 Or C < 4 Or C > 7 Then Exit Sub
   
7.      .Interior.ColorIndex = xlNone
   
8.      If .Value = "" Then Exit Sub
   
9.      Set IdRng = Cells(.Row, 2)
   
10.      If IdRng = "" Then Exit Sub
    
11.      Set xF = Sheets("Sheet1").[B:B].Find(IdRng, lookat:=xlWhole)
    
12.      If xF Is Nothing Then MsgBox "§ä¤£¨ì¨­¥÷ÃÒ¸¹¡I": Exit Sub
    
13.      If xF(1, 0) <> IdRng(1, 0) Then MsgBox "¨­¥÷ÃÒ¸¹»P©m¦W¤£²Å¡I": Exit Sub
    
14.      If xF(1, 21) = "µ²·~" Then MsgBox "¥»µ§¤w¡eµ²·~¡f¡I": .ClearContents: Exit Sub
    
15.      
    
16.      If Not IsDate(.Value) Then MsgBox "¿é¤J¤é´Á®æ¦¡¿ù»~¡I":  Exit Sub
    
17.      For j = 1 To 3
    
18.          Set xR = xF(1, 7 + (C - 4) * 3 + j)
    
19.          If xR = .Value Then Jm = 1
    
20.          If xR <> "" Then Km = Km + 1
    
21.          If Jm = 0 And xR = "" Then xR = .Value: Exit Sub
    
22.      Next
    
23.      If Km = 3 Then .Interior.ColorIndex = 6: MsgBox "¥»°Ï¶¡¤é´Á¤w¶ñº¡¡I": Exit Sub
    
24.      If Jm = 1 Then .Interior.ColorIndex = 3: MsgBox "¿é¤J¤é´Á¤w¦s¦b¡I"
    
25. End With
    
26. End Sub

½Æ»s¥N½X

Xl0000143(¨­¥÷¤ñ¹ï).rar (27.13 KB)

¤U¸ü¦¸¼Æ: 10

2017-4-8 20:08

¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð
¢°¡D¤u§@ªí¦WºÙ¦Û¦æ¥h§ï
¢±¡Dµ{¦¡½XªºÁcÅ餤¤å¦r¡A¦Û¦æ§ï¬°Â²Åé
¡@
¡@

Farnsworth

¦^´_ 3# ­ã´£³¡ªL


    乱码ªº问题§Ú¥i¥H§ï¡A烦请±z给写写VAB¥N码¡A·P谢¡I¡I¡I¥H«e¡A§A们给§Ú写过¡A乱码ªº问题¬O§Ú¦Û¤v¸Ñ

­ã´£³¡ªL

¦^´_ 2# Farnsworth


¢°¡D§Aªº¨t²Î¬O²Å骩¡A¦bÁcÅ骩¤¤¼gVBA®É¡A­Y»Ý¨Ï¥Î¤¤¤å¦rµLªk¬Û®e¡]³£¬O¶Ã½X¡^¡A¦p¤u§@ªí¦WºÙ¡þMSGBOX´£¥Ü¤å¦r¡A³o¬O°ÝÃD¤@
¢±¡D»Ý¨D¬yµ{¤£¤Ó¸Ô²Ó¡Ä¡Ä°ò¦ªíªº¤º®e«ç»ò¨Óªº¡H
¡@¡@¬O¦b¡e©ú²Óªí¡f¿é¤J«á¡A¥H¡e¶×¥X¡f¤è¦¡¶ñ¦Ü¡e°ò¦ªí¡f¡H
¡@¡@¶ñ¤J«á¡A°ò¦ªí¤£¥i³Q§ó°Ê¡]¤u§@ªí«OÅ@¡H¡^¡A¨º¡eµ²·~¡f¨â¦r¦p¦ó¿é¤J¡H
¢²¡D¬JµM¦³¡e¨­¥÷ÃÒ¸¹¡f¥i¤ñ¹ï¡]¨ä¯S©ÊÀ³¬O¤£·|­«ÂС^¡A¬°¦óÁÙ­n¦P®É¤ñ¹ï¡e©m¦W¡f¡H

²Å骩¡A«Øij¨ìEXCEL-HOMEªºµ{§Çª©¥hµo©«¨D§U¡G
http://club.excelhome.net/forum-2-1.html
¡@
¡@

Farnsworth

¦U¦ì°ª¤â¡Aµ¥ªº§Ú¤ßµh°Ú¡I«æ»Ý­n°Ú¡I个¤H¯à¤O¦³­­¡A恳请°ª¤â