[حل شده] پیدا کردن عدد های مثل هم

[elam]

سلام
توفایل پیوست من دو ستون دارم که عددهای مختلفی درج شده کاری که می خوام بکنم اینه که عدد اول ستون a را تو کل ستون b بررسی کنه اگه بود خط بزنه ( یعنی هم عدد ستون a و هم عدد ستون b ) بعد عدد دوم را بررسی کنه اگه بود دوباره به همون منوال فقط یه نکته ای اگه مثلا عدد 1000 را تو ستون a 5 بار بود و تو ستون b بار بود باید 2 تا 1000 تو ستون b بمونه
ممنون از لطفتون

[iranweld]

با سلام

فایل پیوست را بررسی نمایید

Sub test()

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


For J = 1 To z2

If Range("A" & I) = Range("B" & J) Then

Range("A" & I) = ""

Range("B" & J) = ""


Exit For

End If

Next


Next

End Sub 

[elam]

دقیقا منظورم همین بوده منتها امکانش هست که مثلاً تکراری ها را صورتی بکنه و خط روش بکشه منتها عدد حذف نشه.

[iranweld]

دقیقا منظورم همین بوده منتها امکانش هست که مثلاً تکراری ها را صورتی بکنه و خط روش بکشه منتها عدد حذف نشه.

رنگی شدن تکراری ها

[elam]

ممنون ولی فکر کنم یه جاش هنوز مونده که درست بشه مثلا تو ستون اول اگه 3 تا عدد 1000 داشته باشیم و تو ستون دوم دو تا،همه 1000 های ستون اول را میگیره و از ستون دوم فقط یکی را میگیره، در صورتیکه روال اینکه اولین هزار از ستون اول با اولین هزار از ستون دوم و بهمین منوال

[iranweld]

ممنون ولی فکر کنم یه جاش هنوز مونده که درست بشه مثلا تو ستون اول اگه 3 تا عدد 1000 داشته باشیم و تو ستون دوم دو تا،همه 1000 های ستون اول را میگیره و از ستون دوم فقط یکی را میگیره، در صورتیکه روال اینکه اولین هزار از ستون اول با اولین هزار از ستون دوم و بهمین منوال

عدم رنگی شدن تکرارهای های بعدی ستون A

Sub test()

Dim LIST1 As New Collection

z1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

z2 = Sheet1.Cells(Sheet1.Rows.Count, "b").End(xlUp).Row


On Error Resume Next

For I = 1 To z1

T = 0


For K = 1 To LIST1.Count

If Range("A" & I) = LIST1.Item(K) Then

T = 1

End If

Next K

For J = 1 To z2

If T = 0 And Range("A" & I) = Range("B" & J) Then

Range("A" & I).Interior.ColorIndex = 3

Range("B" & J).Interior.ColorIndex = 4

LIST1.Add Range("A" & I), CStr(Range("A" & I))

Exit For

End If


Next


Next

End Sub 

[elam]

تست کردم متاسفانه جواب نداد

[iranweld]

تست کردم متاسفانه جواب نداد

بررسی کنید بدین صورت مد نظر شماست

[elam]

نه متاسفانه
تو همین مثال چک بفرمایید عدد 1000 در ستون اول و دوم

[iranweld]

نه متاسفانه
تو همین مثال چک بفرمایید عدد 1000 در ستون اول و دوم

در همین فایل به تعداد مساوی از هر عدد که در دو ستون موجود باشد عددها رنگی میگردند و هر ستونی که آن عدد را بیشتر داشته باشد رنگی نمیگردد

قبل از اجرای مجدد ماکرو بایستی رنگ سلولها را به صورت بی رنگ درآورید

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

[elam]

خیلی ممنون استاد متشکر