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

[µo°Ý] VBA_¤G­Óµ{¦¡¦X¨Ö«áªº©³¦â¼Ð¥Ü¤§»yªk­×¥¿¡C

[µo°Ý] VBA_¤G­Óµ{¦¡¦X¨Ö«áªº©³¦â¼Ð¥Ü¤§»yªk­×¥¿¡C

2016-0128-Q-1 -.rar (86.1 KB)

¤U¦C¤G­Óµ{¦¡¥u¦³¦C11¦³®t²§¡A¨ä¾l³£¬Û¦P¡C
A°Ï©MB°Ïªº¡i¥ô¤@¦C¡j¹ïÀ³¦C¥æ¶°­È=C°Ï~¦PÄæ&¤£­­¦PÄæ
Private Sub CommandButton1_Click()
Dim b As Range, RW, R(1 To 3) As Range, UR(1 To 3) As Range, x%, z%, i%, U%

With Sheets(2)
      Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7]
      Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row)  '¤£¥ÎSelect¡Aª½±µ¸õ¿ï¥Ø¼Ð°Ï
      For Each b In Selection
          If b <> "" Then
          If .Range("R" & b.Row) < .[T5] And .Range("R" & b.Row) - 4 > 0 Then
      
          RW = Array(b(1, -1), .[T5], .[R6])    '¦C11
          For x = 1 To 4
          For i = 1 To 3: Set UR(i) = Nothing: Next
          For z = 1 To 7
          Set R(1) = .[J6].Cells(RW(0) - x + 1, z): U = 0
              For i = 2 To 3
              Set R(i) = Nothing
              'Set R(i) = .[J6:P6].Offset(RW(i - 1) - x, 0).Find(R(1), Lookat:=xlWhole) '¤£¦PÄæ
              'If Not R(i) Is Nothing Then U = U + i '¤£¦PÄæ
              Set R(i) = .[J6:P6].Cells(RW(i - 1) - x + 1, z) '¦PÄæ
              If R(i) = R(1) Then U = U + i '¦PÄæ
              Next i
          If U = 2 Then Set UR(1) = Nothing: Exit For
          If U = 5 Then
          For i = 1 To 3
              If UR(i) Is Nothing Then Set UR(i) = R(i) Else Set UR(i) = Union(UR(i), R(i))
          Next i
          End If
          Next z
          If Not UR(1) Is Nothing Then
          For i = 1 To 3
          For Each R(1) In UR(i): R(1).Interior.ColorIndex = Array(8, 4, 6)(i - 1): Next
          Next i
          End If
          Next x
         
          End If
          End If
      Next b
      .[A1].Select
End With
End Sub

C°Ï©MB°Ïªº¡i¥ô¤@¦C¡j¹ïÀ³¦C¥æ¶°­È=A°Ï~¦PÄæ&¤£­­¦PÄæ
Private Sub CommandButton1_Click()
¡J
¡J
¡J
          RW = Array(.[R6], .[T5], b(1, -1))    '¦C11
¡J
¡J
¡J
End Sub

¤µ±N¤W­z¤G­Óµ{¦¡¦X¨Ö«á¦¨¬°~
A°Ï©MB°Ïªº¡i¥ô¤@¦C¡j¹ïÀ³¦C¥æ¶°­È=C°Ï&C°Ï©MB°Ïªº¡i¥ô¤@¦C¡j¹ïÀ³¦C¥æ¶°­È=A°Ï~¦PÄæ&¤£­­¦PÄ檺µ{¦¡ÀÉ®×~
¨ä©³¦âµLªk¹F¦¨¦pT7¤½¦¡ªº»Ý¨D~
§Y¦p½d¨ÒÀɪº»²§U¹Ï¥ÜW¡JAC©MAJ¡JAP¦P®É¦³¼Ð¥Ü¦P¼Ë©³¦â®É¡AJ¡JP¤~¼Ð¥Ü¦P¼Ë©³¦â~
(§YN91¡AN102¡AN105ªºÀx¦s®æ¨S¦³¼Ð¥Ü©³¦â¤~¬O¥¿½Tªº)

½Ð°Ý¡JÀ³¸Ó¦p¦ó­×¥¿¦X¨Öªºµ{¦¡½X¡A¤~¯à¹F¨ì¦p½d¨ÒÀɪºJ¡JP¤§¥¿½T©³¦â¼Ð¥Ü?

¥H¤W  Àµ½Ð¦U¦ì¥ý¶i¡B«e½ú¤£§[½ç±Ð!  ÁÂÁÂ!

¥»©«³Ì«á¥Ñ Airman ©ó 2016-1-29 02:51 ½s¿è

¸É¥R»¡©ú:
A°Ï©MB°Ïªº¡i¥ô¤@¦C¡j¹ïÀ³¦C¥æ¶°­È=C°Ï~¦PÄæ&¤£­­¦PÄæ
ªº­ìÃD·N©Mµ{¦¡½Ð¸Ô¨£:  http://forum.twbts.com/thread-16067-1-1.html  #5©M#6
ÁÂÁÂ!

TOP

¦b¤W¤è¥ý©w¸q¥H¤UÅܼơG
Dim SW, H(1 To 3) As Range, V%
¡@
¡@
RW = Array(b(1, -1), .[T5], .[R6])
SW = Array(.[R6], .[T5], b(1, -1))
For x = 1 To 4
For i = 1 To 3: Set UR(i) = Nothing: Next
¡@¡@For z = 1 To 7
¡@¡@¡@¡@Set R(1) = .[J6].Cells(RW(0) - x + 1, z): U = 0
¡@¡@¡@¡@Set H(1) = .[J6].Cells(SW(0) - x + 1, z): V = 0
¡@¡@¡@¡@For i = 2 To 3
¡@¡@¡@¡@¡@¡@Set R(i) = Nothing
¡@¡@¡@¡@¡@¡@Set R(i) = .[J6:P6].Cells(RW(i - 1) - x + 1, z) '¦PÄæ
¡@¡@¡@¡@¡@¡@If R(i) = R(1) Then U = U + i '¦PÄæ
¡@
¡@¡@¡@¡@¡@¡@Set H(i) = Nothing
¡@¡@¡@¡@¡@¡@Set H(i) = .[J6:P6].Cells(SW(i - 1) - x + 1, z)
¡@¡@¡@¡@¡@¡@If H(i) = H(1) Then V = V + i
¡@¡@¡@¡@Next i
¡@¡@¡@¡@If U = 2 Or V = 2 Then Set UR(1) = Nothing: Exit For
¡@¡@¡@¡@If U = 5 And V = 5 Then
¡@¡@¡@¡@¡@¡@For i = 1 To 3
¡@¡@¡@¡@¡@¡@¡@¡@If UR(i) Is Nothing Then Set UR(i) = R(i) Else Set UR(i) = Union(UR(i), R(i))
¡@¡@¡@¡@¡@¡@Next i
¡@¡@¡@¡@End If
¡@¡@Next z
¡@
¡@¡@If Not UR(1) Is Nothing Then
¡@¡@¡@¡@For i = 1 To 3
¡@¡@¡@¡@¡@¡@For Each R(1) In UR(i): R(1).Interior.ColorIndex = Array(8, 4, 6)(i - 1): Next
¡@¡@¡@¡@Next i
¡@¡@End If
Next x

TOP

¦^´_ 3# ­ã´£³¡ªL
­ã¤j:
´ú¸ÕOK¤F~ÁÂÁ±z

¸U¤À·P¿E±z¤@¦A­@¤ß½ç±Ð~·P®¦

TOP

        ÀR«ä¦Û¦b : ¨ü¤HÂI¤ô¤§®¦¡A¶··í´é¬u¥H³ø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD