[حل شده] رکوردها متشابه

[thaqeb]

New Microsoft Excel Worksheet.xlsxبا سلام واحترام
در فایل اکسل که پیوست می باشد می خواهم رکوردهای متشابه ستون aرا با ستون bرا مقابل هم قرار بگیرند و رنگی شوند با تشکر

[amir_ts]

با سلام
فایل پیوستی رو ملاحظه کنید.

[thaqeb]

سلام ممنون از زحمات شما ولی منظورم این بود که در همان دو ستون مقابل هم قرار بگیرند لطفا راهنمایی فرمایید

[amir_ts]

کد زیر رو امتحان کنید.

[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]

[iranweld]

با سلام

در فایل پیوست دیتای مشابه روبروی هم قرار گرفته و دیتای غیر مشابه به پایین ستون B منتقل میگردد.

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