[LEFT]
Sub test()
Dim lr As Integer
Dim s As Variant
On Error Resume Next
lr = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
v = 0
For i = 1 To lr
s = Application.Match(Cells(i, 1).Value, Range("b1:b" & lr), 0)
If Not IsError(s) Then
t = Cells(i, 2).Value
Cells(23 + v, 2).Value = t
v = v + 1
End If
Next
lr2 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
For i = 1 To lr
u = Application.Match(Cells(i, 1).Value, Range("b1:b" & lr2), 0)
If Not IsError(u) Then
Cells(i, 2).Value = Range("b" & u)
End If
Next
For i = 1 To lr2
m = Application.CountIf(Range("b1:b" & lr2), Range("b" & i))
If (Range("a" & i).Value <> Range("b" & i).Value) And m > 1 Then
Range("b" & i).Value = ""
End If
Next
End Sub[/LEFT]
Private Sub CommandButton1_Click()
Range("A" & I & ":B" & I).Interior.ColorIndex = 0
Z1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Z2 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
For I = 1 To Z1
T = 0
For J = 1 To Z2
If Range("B" & J) = Range("A" & I) Then
TEMP = Range("B" & I)
Range("B" & I) = Range("B" & J)
Range("A" & I & ":B" & I).Interior.ColorIndex = 4
Range("B" & J) = TEMP
T = 1
End If
Next
If T = O Then
TEMP = Range("B" & I)
Range("B" & I) = ""
Range("B" & Z2 + 1) = TEMP
Z2 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
End If
Next
End Sub
کامنت