سليم حاصبيا

بعد اذن اخي ابو حنين هذا الكود(ربما اسره قليلاُ) حيث انه يخرج من الـ Loop فور حصوله على نتيجة Sub transfer() Dim i As Long, tr As Boolean, x, y As Integer Dim lra, lrb, lr As Long lrb = Cells(Rows.Count, 2).End(3).Row lra = Cells(Rows.Count, 1).End(3).Row lr = Application.Max(lrb, lra) Range("c2:d" & lr).ClearContents i = 2 Do Until Range("a" & i) = "" tr = False x = Application.CountIf(Range("a2:a" & i), Range("a" & i)) y = Application.CountIf(Range("b2:b" & lrb), Range("a" & i)) If x = 1 And y = 0 Then tr = True: GoTo 1 End If 1: If tr = True Then Cells(m + 2, 3) = Range("a" & i) m = m + 1 End If i = i + 1 Loop '====================================== m = 0 i = 2 Do Until Range("b" & i) = "" tr = False x = Application.CountIf(Range("b2:b" & i), Range("b" & i)) y = Application.CountIf(Range("a2:a" & lra), Range("b" & i)) If x = 1 And y = 0 Then tr = True: GoTo 2 End If 2: If tr = True Then Cells(m + 2, 4) = Range("b" & i) m = m + 1 End If i = i + 1 Loop End Sub

ارفع الملف او جزءًا منه اذا كان كبيراً لاكتشاف المشكل

تفضل الملف جاهز الموردن salim.rar

يجب عليك تنشيط المعادلات بأن تحدد المعادلات تضغط على المفتاح F2 ثم تضغط Ctrl+Enter

فعلت ذلك دون نتيجة

ربما يعجبك هذا الملف (كلما اضفت صفحة يجب عليك تنشيط المعادلات و ذلك بالسحب نزولاً) enmerate_sheets .rar

جرب هذا الملف sheet_list.rar

لا يسمح لك اكسل يتكرار اسم الصنف لتعبئة الفاتورة: 1-اضفط على الزر Show_ALL 2- قبل الطباعة اضغط على الزر Only Data (لطباعة الخلايا غير الفارغة) Salim facteur.rar

جرب هذا الملف Split_names.rar أو يمكن استعمال هذا الماكرو من سطر واحد Sub Split_Names() Range("A2:A" & Cells(Rows.Count, "A").End(3).Row).TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True End Sub

جرب هذين الكودين الاول لاخفاء الصفوف التي تحتوي عل صفر في العامود R و الثاني لاظهار كل شيء Sub hide_rows_with_zero() Application.ScreenUpdating = False ActiveSheet.Cells.EntireRow.Hidden = False rr = Cells(Rows.Count, "r").End(3).Row For k = 1 To rr If Cells(k, "r") = 0 Then Cells(k, "r").EntireRow.Hidden = True Next Application.ScreenUpdating = True End Sub '============================================ Sub Unhide_ALL() ActiveSheet.Cells.EntireRow.Hidden = False End Sub '========================================

بعد اذن الاخ مختار جرب هذا الملف Split_names.rar

استبدل الرقم 2 بالرقم 4 ليصبح الكود هكذا If .AutoFilterMode = True Then .Range("A4").AutoFilter

جرب هذا الملف المشكلة ان الملف كبير جداً (حوالي 2500 صف) والبيانات كثيرة (تضييع وقت ) حاول رفع نسخة صغيرة عنه (حوالي 20 اسم) انا اقوم بوضع الكود ثم تقوم انت بتعديله ليتناسب مع المعطيات عندك تم معالجة الامر School.rar

جرب هذا الملف المشكلة ان الملف كبير جداً (حوالي 2500 صف) والبيانات كثيرة (تضييع وقت ) حاول رفع نسخة صغيرة عنه (حوالي 20 اسم) انا اقوم بوضع الكود ثم تقوم انت بتعديله ليتناسب مع المعطيات عندك

لعل السائل يرد ان يظهر له هذا الشكل Power.rar

جرب هذا الكود Private Sub Worksheet_Deactivate() On Error Resume Next Application.ScreenUpdating = False my_sheet = ActiveSheet.Name Application.Undo With ActiveSheet ' بما تراه مناسبا Range("A2") استبدل هنا If .AutoFilterMode = True Then .Range("A2").AutoFilter End With Sheets(my_sheet).Select Application.ScreenUpdating = True End Sub

ربما يكون المطلوب عليك فقط كتابة اسماء الاصناف (يمكن التكرار) والكميات في الخلايا المناسبة و رقم الاذن و اكسل يقوم بالباقي عملية طرح SALIM.rar

جرب هذا الملف 1111salim_macro.rar

جرب هذين الماكروين Sub hidde_columns() 'اخفاء الأعمدة unhidde_columns For i = 1 To Range("b1:j1").Count If Range("b1:j1").Cells(i) = 0 Then Range("b1:j1").Cells(i).EntireColumn.Hidden = True End If Next End Sub '============================================ Sub unhidde_columns() 'اظهار الاعمدة Range("b1:j1").EntireColumn.Hidden = False End Sub

اثراء للموضوع هذا الكود salim Find_repetition.rar

ربما يفيدك هذا الملف تشابه.rar

اكتب هذه المعادلة في الخلية C2 واسحب نزولاً =IF(B2="",A2,A2&"- "&B2)

كيف تختار المعلمين دون تضارب في الحصص انظر الى الملف (نموذج) المرفق teachers_choose.rar

اليك ما يجب ان تقوم به If Not Intersect(Target, Range("PRot_range")) Is Nothing Then في هذا السطر من الكود بدل عبارة Range ("PRot_range") الى اي نطاق تريد مثلاً Range("a2:n50")

جرب هذ الملف protect non empty data with Pass word.rar