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

جرب المعادلة بهذا الشكل .. غير النطاق الذي تريد العد على أساسه وشرط العد .. المعادلة يمكن أن تزيد عدد الشروط .. النطاق يليه الشرط ، والنطاق يليه الشرط ، والنطاق يليه الشرط ... كفاية كدا ولا أكتب كمان ::::::::

=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

أخي الكريم محمد

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

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

تقبل وافر تقديري واحترامي

أخي الكريم 

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

مزيد من التفاصيل ربما يساعدك في إتمام حل المشكلة إن شاء الله

حسب علمي لا يوجد تغيير لنمط الخط أو التنسيق لجزء من معادلة .. ربما يمكن استخدام الـ 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