VBA_3AA_4_¹ïÀ³¦Cªº¦PÄæ¥æ¶°È¼Ð¥Ü©³¦â¡C.rar (25.37 KB)
¥H¤Uµ{¦¡»yªk~½Ð¦A¥[¤J¤@¬q¡J
±N¦U¦PÄæ¦ìªº¬Û¦PÈ(¥æ¶°È)¼Ð¥Ü©³¦âªºµ{¦¡½X¡C
¸Ô²Ó¹Ï¥Ü¦pªþ¥ó¡C
ÁÂÁÂ!
Private Sub CommandButton1_Click()
Dim b As Range, RW, y%
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 > 1 Then
Dim R(1 To 3) As Range, x%, z%, i%, U%
RW = Array(.[T5], .[R6], b(1, -1))
For x = 1 To 4
For y = 1 To 7
Set R(1) = .[J6].Cells(RW(0) - x + 1, y): U = 0
For z = 2 To 3
Set R(z) = .[J6:P6].Offset(RW(z - 1) - x, 0).Find(R(1), Lookat:=xlWhole)
If R(z) Is Nothing Then U = 1: Exit For
Next z
If U = 0 Then
For i = 1 To 3: R(i).Interior.ColorIndex = Array(4, 6, 8)(i - 1): Next
End If
Next y
Next x
End If
End If
Next b
.[A1].Select
End With
End Sub |