رکوردها متشابه

[thaqeb]

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

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[amir_ts]

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

[thaqeb]

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

[amir_ts]

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

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

[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