ياسر خليل أبو البراء

جرب المعادلة بهذا الشكل .. غير النطاق الذي تريد العد على أساسه وشرط العد .. المعادلة يمكن أن تزيد عدد الشروط .. النطاق يليه الشرط ، والنطاق يليه الشرط ، والنطاق يليه الشرط ... كفاية كدا ولا أكتب كمان :::::::: =COUNTIFS($C$2:$C$348,6,$F$2:$F$348,"مسيحية",$G$2:$G$348,"P")

في هذه الحالة لابد من تغييير خصائص القائمة المنسدلة لتسمح بأي إدخال وسيقوم الكود بالفلترة بشكل عادي على المدخلات التي سيتم إدخالها في الخلية K9 ..

وعليكم السلام أخي محمد جرب الكود بهذا الشكل Private Sub CommandButton1_Click() If TextBox1 - TextBox2 <= 0 Then TextBox3 = 0 Else TextBox3 = TextBox1 - TextBox2 End If End Sub

أعتقد أن الموضوع مكرر بهذا الشكل .. يرجى عدم طرح الموضوع أكثر من مرة

وعليكم السلام أخي الكريم سامي لما لا تقوم بوضع التفاصيل في الموضوع نفسه قبل إرفاق الملف .. جرب الكود التالي حسب ما فهمت من ملفك .. حيث يمكن أن يكون كود واحد يشمل الحالة الأولى والثانية أما النقطة الثالثة فلم أفهمها .. أو فهمتها ولكن حسب فهمي أنت محدد خيارات محددة في القائمة المنسدلة .. ماذا تريد بالضبط في النقطة الثالثة ..؟!! Sub Test() Dim o As Object With ActiveSheet Set o = .ListObjects("الجدول1") If .Range("K9") = "" Or .Range("K9") = 0 Then o.AutoFilter.ShowAllData: Exit Sub .ListObjects("الجدول1").Range.AutoFilter Field:=9, Criteria1:=Range("K9") End With End Sub

السلام عليكم أخي الكريم هلا وضحت بمزيد من التفاصيل المطلوب ... هل سيتم تعبئة كل الحقول في الفورم قبل عملية الترحيل للجداول .. الأفضل أن ترفق صورة توضح فيها الأداة المطلوب ترحيلها وإلى أين سترحل لتيسير عملية المساعدة من قبل إخوانك بالمنتدى ليس لي خبرة كبيرة في التعامل مع الفورم .. ولكن أحببت أن أشاركك الموضوع وإن شاء الله تجد من يساعدك

وعليكم السلام أخي العزيز سمير النجار بارك الله فيك وجزاك الله خيراً في الحقيقة رأيت هذا الدرس التعليمي في أحد المواقع من فترة وقمت بتطبيقه لأستفيد أنا شخصياً منه ، وأحببت أن أشارك به إخواني لأني رأيت أكثر من موضوع لنفس الطلب تقبل تحياتي

أخي الكريم طلبك بسيط لكن ارفق ملف ليعمل عليه الأخوة الكرام بالمنتدى ... يمكن استخدام الدوال COUNTIF أو SUMPRODUCT

أخي الكريم محمد أعتذر إليك لعدم قدرتي على الرد على كل الموضوعات التي تطرحها .. لأنه إما أكون مشغول وليس لدي وقت يكفي للرد على جميع الموضوعات أو أنني ليس لدي علم بالأمر أو أن الموضوع غير مكتمل الأركان حاول توضح المطلوب بشيء من التفصيل كما أخبرتك من قبل حيث يساعدك ذلك على تدخل الأخوة الأعضاء والمشاركة في الموضوعات تقبل وافر تقديري واحترامي

أخي الكريم هل تريد الحل بالمعادلات أم بالأكواد ..؟ وأين سيتم عمل قوائم منسدلة في عمود الزبائن والعقود فقط ؟؟ وماذا عن العمود الأخير لماذا تريد فيه قائمة .. أليس من الممكن وضع معادلة تجلب البيانات الخاصة بهذا الاسم وهذا العقد؟ مزيد من التفاصيل ربما يساعدك في إتمام حل المشكلة إن شاء الله

السلام عليكم مع درس جديد وتعلم عمل فورم شريط التقدم Progress Bar ، والذي يستخدم في حالة الأكواد التي تستغرق وقت ليظهر مدى تقدم الكود ، ومرفق مع الملف صور لكيفية ضبط أدوات التحكم على الفورم .. https://www.file-upload.com/p9rtijdjg3ki

حسب علمي لا يوجد تغيير لنمط الخط أو التنسيق لجزء من معادلة .. ربما يمكن استخدام الـ VBA لعمل ذلك ..

أخي الكريم لم أفهم المشكلة ...يمكنك طرح موضوع من جديد مع الشرح للمشكلة وإرفاق الملفات المطلوبة لربما تجد من يساعدك أنا نسيت الموضوع .. أيوا والله زي ما بقولك كدا

يوضع الكود في مويول عادي لمعرفة المزيد حول الأساسيات المطلوبة للتعامل مع الأكواد لابد من مشاهدة الفيديو التالي

أخي الكريم ارفق ملف بالمعطيات وشكل النتائج المتوقعة .. لكي تجد استجابة أفضل

هل الملفات كلها في مجلد واحد أم مجلدات متعددة؟ لما لا تذكر التفاصيل وتضع الكود الذي تستخدمه عموماً جرب الكود التالي .. 'Written: July 05, 2017 'Author: Leith Ross #If Win64 = True Then Private Declare PtrSafe Function ShellExecute _ Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As LongPtr, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As LongPtr #Else Private Declare Function ShellExecute _ Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long #End If Sub PrintAllFiles() Dim ActPrtr As String Dim answer As Integer Dim File As Variant Dim Folder As Variant Dim Item As Variant Dim Items As Object Dim PrtJobs As Object Dim PSEx() As String Dim ret As Long Dim WMI As Object ActPrtr = Split(Application.ActivePrinter, " on ")(0) 'Printer Status Extended ReDim PSEx(1 To 18) PSEx(1) = "Other - Not Listed" PSEx(2) = "Undetermined" PSEx(3) = "Printer is Idle" PSEx(4) = "Printer is Printing" PSEx(5) = "Printer is Warming Up" PSEx(6) = "Printer has Stopped Printing" PSEx(7) = "Printer is Offline" PSEx(8) = "Printer is Paused" PSEx(9) = "An Error occured" PSEx(10) = "Printer is Busy" PSEx(11) = "Printer is Not Available" PSEx(12) = "Printer is Waiting" PSEx(13) = "Printer is Processing" PSEx(14) = "Printer is Initializing" PSEx(15) = "Printer is in Power Save Mode" PSEx(16) = "Job is Pending Deletion" PSEx(17) = "I/O Active" PSEx(18) = "Manual Feed required" Set WMI = GetObject("winmgmts:\\.\root\CIMV2") Set Items = WMI.ExecQuery("SELECT * FROM Win32_Printer") With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show If .SelectedItems.Count > 0 Then Folder = .SelectedItems(1) Else Exit Sub End If End With File = Dir(Folder & "\*.*") PrintFiles: Do While File <> "" GoSub CheckPrinterStatus ret = ShellExecute(0&, "Print", File, vbNullString, Folder, 1&) If ret < 32 Then MsgBox "Print Command Failed." & vbLf & vbLf & "Error: " & ret Exit Sub End If File = Dir() Loop Exit Sub CheckPrinterStatus: For Each Item In Items If Item.Name = ActPrtr Then If Item.Status <> "OK" Then answer = MsgBox(ActPrtr & " Is Not Ready To Print." & vbLf & vbLf _ & "Status: " & Item.Status & vbLf & "Cause: " & PSEx(Item.ExtendedPrinterStatus) _ & vbLf & vbLf & "Wait For Printer?", vbExclamation + vbYesNo + vbDefaultButton2) If answer = vbNo Then answer = MsgBox("Do You Want Clear All Remaining Print Jobs?", vbQuestion + vbYesNo) If answer = vbYes Then GoTo ClearPrintJobs Else Exit Sub End If End If End If Next Item Return ClearPrintJobs: Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set PrtJobs = WMI.ExecQuery("select * from Win32_Printer where PrinterState=0 and PrinterStatus=6") For Each Item In PrtJobs Item.CancelAllJobs Next Item End Sub

وعليكم السلام أخي الكريم الموضوع غير مكتمل الأركان .. ارفق نماذج بسيطة من ملفاتك ووضح هل الملفات ملفات إكسيل فقط أم أن هناك ملفات أخرى وإذا كانت ملفات إكسيل هل يوجد أوراق عمل أخرى أم أنها ورقة واحدة فقط؟ وأين الكود الذي يطبع 15 ملف فقط ولا يطبع بقية الملفات؟

ربنا يكرمك أخي محمود إنت هتيأس من دلوقتي ولا ايه أقصد الكود الأول بسيط ومباشر ..يعني لو قمت بتسجيل ماكرو بالخطوات ستعرف إنه بسيط حيث يتم نسخ النطاق المطلوب لورقة العمل الثانية ثم إزالة المكرر باستخدام خاصية Remove Duplicates الموجودة في التبويب Data ثم حذف الأعمدة الغير ضرورية ثم نقل العمود إلى العمود الذي قبله للترتيب ...أمور بسيطة لتتعلم الأكواد حاول تستخدم مفتاح F8 لتنفيذ الكود سطر بسطر .. لتتعلم وتعرف ما يحدث أول بأول ..

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي

وعليكم السلام تفضل أخي كود بسيط جداً ومفهوم ... بالطريقة العادية Sub DeleteDuplicatesFromTwoColumns() Dim ws As Worksheet Dim sh As Worksheet Dim rng As Range Application.ScreenUpdating = False Set ws = Sheets("بيانات") Set sh = Sheets("جدول") With sh Set rng = ws.Range("G1:K" & ws.Cells(Rows.Count, "G").End(xlUp).Row) rng.Copy .Range("G1") .Range("G1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 5), Header:=xlNo .Columns("H:J").Delete .Columns(8).Cut: .Columns(7).Insert Shift:=xlToRight .Range("G2:H" & .Cells(Rows.Count, "G").End(xlUp).Row).Copy .Range("A2").PasteSpecial xlPasteValues .Columns("G:H").Clear Application.CutCopyMode = False End With Application.ScreenUpdating = True End Sub وإذا أردت كود متقدم فتفضل الكود التالي .. حيث التعامل يكون بعيد عن التعامل مع ورقة العمل بشكل مباشر .. Sub UniqueFromTwoColumns() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim e As Variant Dim i As Long Set ws = Sheets("بيانات") Set sh = Sheets("جدول") arr = ws.Range("G1:K" & ws.Cells(Rows.Count, "G").End(xlUp).Row).Value With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 2 To UBound(arr) .Item(arr(i, 5) & "," & arr(i, 1)) = .Item(arr(i, 5) & "," & arr(i, 1)) Next i i = 2 sh.Range("A1:B1").Value = Array("الكود", "الاسم") For Each e In .keys sh.Cells(i, "A").Resize(, 2) = Split(e, ",") i = i + 1 Next e End With End Sub

وعليكم السلام أخي الكريم أهلاً بك في المنتدى حدد النطاق G2:H11 في ورقة العمل المسماة "بيانات" .. انسخ النطاق والصقه في ورقة العمل المسماة "جدول" في الخلية G1 على سبيل المثال .. اذهب للتبويب Data ستجد أمر اسمه Remove Duplicates انقر عليه وستظهر نافذة اضغط على OK .. وستحصل على المطلوب إن شاء الله

هذه معادلة صفيف أي لابد من الضغط على Ctrl + Shift + Enter

ولإثراء الموضوع هذا حل آخر بالمعادلات في الخلية D5 ضع المعادلة التالية (معادلة صفيف أي يتم الضغط على Ctrl + Shift + Enter حين إدخال المعادلة ) =INDEX(الحركه!$F$5:$F$25,MATCH(MAX(IF((الحركه!$C$5:$C$25="شراء")*(الحركه!$D$5:$D$25=$B$5),ROW(الحركه!$D$5:$D$25),"")),ROW(الحركه!$D$5:$D$25),0)) وفي الخلية E5 ضع معادلة عادية لطرح الخلايا بهذا الشكل (لمعرفة الفرق) =C5-D5 وفي الخلية F5 ضع المعادلة التالية (معادلة صفيف أيضاً) =INDEX(الحركه!$B$5:$B$25,MATCH(MAX(IF((الحركه!$C$5:$C$25="شراء")*(الحركه!$D$5:$D$25=$B$5),ROW(الحركه!$D$5:$D$25),"")),ROW(الحركه!$D$5:$D$25),0))

أخي الكريم أحمد جرب الكود التالي في حدث ورقة العمل المسماة "الاستعلام" Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B5:C5")) Is Nothing Then Dim ws As Worksheet Dim i As Long Set ws = Sheets("الحركه") For i = ws.Cells(Rows.Count, 2).End(xlUp).Row To 5 Step -1 If ws.Cells(i, 3).Value = "شراء" And ws.Cells(i, 4).Value = Range("B5").Value Then Range("D5").Value = ws.Cells(i, 6).Value Range("E5").Value = Range("C5").Value - Range("D5").Value Range("F5").Value = ws.Cells(i, 2).Value Exit For End If Next i End If End Sub

السلام عليكم أخي الكريم أحمد تفضل الملف التالي نموذج مصغر فيه ما تطلب إن شاء الله .. اطلع على الكود الموجود في الموديول العادي ، واطلع على الكود الموجود في موديول ورقة العمل Sheet1 (وضعت أسطر للشرح) تقبل تحياتي Test.rar