أبو أنس حاجب قام بنشر يونيو 1, 2012 قام بنشر يونيو 1, 2012 السلام عليكم ورحمة الله وبركاته المطلوب حفظكم الله إستخراج وفرز الأسماء من العمود C المتشابهة بالأسم والمتشابهة بالرقم كلاً على حدة إلى الصفحة المجاورة بيانات العمود قد تصل إلى الصف ستون وأغلبها متكررة أبو أنس استخراج التشابه.rar
عبدالله المجرب قام بنشر يونيو 1, 2012 قام بنشر يونيو 1, 2012 السلام عليكم جرب هذا الكود Sub Abu_Ahmed() Dim cl As Range Application.ScreenUpdating = False Set MySh = Sheets("Sheet2") [K2:L300].ClearContents MySh.[B6:C300].ClearContents For i = 6 To [C10000].End(xlUp).Row R = Mid(Cells(i, 3), InStr(Cells(i, 3), "(") + 1, Len(Mid(Cells(i, 3), (InStr(Cells(i, 3), "(") + 1), 10)) - 1) T = Mid(Cells(i, 3), 1, InStr(Cells(i, 3), "(") - 1) Range("K" & [K10000].End(xlUp).Row + 1) = T Range("L" & [L10000].End(xlUp).Row + 1) = R Next For Each cl In Range("C6:C" & [C10000].End(xlUp).Row) RR = Mid(cl, InStr(cl, "(") + 1, Len(Mid(cl, (InStr(cl, "(") + 1), 10)) - 1) w = Application.CountIf([L2:L100], RR) If Application.CountIf([L2:L100], RR) > 1 Then MySh.Range("C" & MySh.[C10000].End(xlUp).Row + 1) = cl TT = Mid(cl, 1, InStr(cl, "(") - 1) WW = Application.CountIf([K2:K100], TT) If WW > 1 Then MySh.Range("B" & MySh.[B10000].End(xlUp).Row + 1) = cl Next [K2:L300].ClearContents Set MySh = Nothing End Sub
أبو أنس حاجب قام بنشر يونيو 1, 2012 الكاتب قام بنشر يونيو 1, 2012 السلام عليكم ورحمة الله وبركاته أستاذي وسيدي الفاضل أبا أحمد (عبد الله المجرب) حفظك الله عذراً سهواً مني لم أشر انه توجد اسماء في العمود بدون أرقام أرجو تجاهلها حيث أن الكود وقف عند اول خلية بها اسم وليس لديه رقم ولم يواصل تنفيذ المطلوب. عافاك الله ويسر لك سبل الخير والصلاح. أبو أنس
عبدالله المجرب قام بنشر يونيو 1, 2012 قام بنشر يونيو 1, 2012 هذا تعديل على الكود Sub Abu_Ahmed() Dim cl As Range Application.ScreenUpdating = False Set MySh = Sheets("Sheet2") [K2:L300].ClearContents MySh.[B6:C300].ClearContents For i = 6 To [C10000].End(xlUp).Row If InStr(Cells(i, 3), "(") = 0 Then GoTo 1 R = Mid(Cells(i, 3), InStr(Cells(i, 3), "(") + 1, Len(Mid(Cells(i, 3), (InStr(Cells(i, 3), "(") + 1), 10)) - 1) T = Mid(Cells(i, 3), 1, InStr(Cells(i, 3), "(") - 1) Range("K" & [K10000].End(xlUp).Row + 1) = T Range("L" & [L10000].End(xlUp).Row + 1) = R 1 Next For Each cl In Range("C6:C" & [C10000].End(xlUp).Row) If InStr(cl, "(") = 0 Then GoTo 2 RR = Mid(cl, InStr(cl, "(") + 1, Len(Mid(cl, (InStr(cl, "(") + 1), 10)) - 1) w = Application.CountIf([L2:L100], RR) If Application.CountIf([L2:L100], RR) > 1 Then MySh.Range("C" & MySh.[C10000].End(xlUp).Row + 1) = cl TT = Mid(cl, 1, InStr(cl, "(") - 1) WW = Application.CountIf([K2:K100], TT) If WW > 1 Then MySh.Range("B" & MySh.[B10000].End(xlUp).Row + 1) = cl 2 Next [K2:L300].ClearContents Set MySh = Nothing End Sub
أبو أنس حاجب قام بنشر يونيو 2, 2012 الكاتب قام بنشر يونيو 2, 2012 السلام عليكم ورحمة الله وبركاته أستاذي وسيدي الفاضل أبا أحمد حفظك الله لقد أرسلت لك رسالة على الخاص أبو أنس
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان