محي الدين ابو البشر

الدرجه الأكبر.xlsx

ربما

فصل الارقام عن الجمل.xlsm

Book2.xlsm

VBA?

Sub test()
    Dim a: Dim i&
    a = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> 0 And a(i, 1) <> "" Then
                If Not .exists(a(i, 1)) Then: .Add a(i, 1), ""
            End If
        Next
       Cells(4, 4) = Application.Small(Application.Transpose(.keys), 2)
       Cells(4, 5) = .Count
    End With
End Sub

Book2.xlsm

ربما

مثال.xlsm

ولك مثل ما دعوت

اقتباس

أحدد انا النطاق مثلا من a1 الى a10

Sub test()
    Dim a
    Dim rng As Range
    Dim r As Range
    Set rng = Application.InputBox(Title:="Please select a range", Prompt:="Select range", Type:=8)
      With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([A-Za-z])+"
   For Each r In rng
       r.Value = Trim(.Replace(r, ""))
        Next
    End With
End Sub

بحيث يمكنك اختيار (النطاق) الذي تريد

ربما

=COUNTIF(C2:C27,"<>0")

=IF(C3>=C2,F2,E2)

والله أعلم 

إذا كنت قد فهمت المطلوب

Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim v As Integer, lr, i
    ListBox1.Clear
    With Sheets("بيان")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To lr
            If .Cells(i, 1).Offset(0, 3) <> 0 And .Cells(i, 1).Offset(0, 4) And .Cells(i, 1).Offset(0, 4) <> 0 Then
                If Sheets("بيان").Cells(i, 1).Offset(0, 0) >= CDate(ComboBox1.Text) Then
                    If Sheets("بيان").Cells(i, 1).Offset(0, 1) = ComboBox2.Text Then
                        If Sheets("بيان").Cells(i, 1).Offset(0, 0) <= CDate(ComboBox3.Text) Then
                            ListBox1.AddItem Sheets("بيان").Cells(i, 1).Value
                            ListBox1.List(v, 1) = Format(Sheets("بيان").Cells(i, 0).Offset(0, 0).Value, "YYYY/MM/DD")
                            ListBox1.List(v, 2) = Sheets("بيان").Cells(i, 1).Offset(0, 1).Value
                            ListBox1.List(v, 3) = Sheets("بيان").Cells(i, 1).Offset(0, 2).Value
                            ListBox1.List(v, 5) = Sheets("بيان").Cells(i, 1).Offset(0, 4).Value

                            v = v + 1
                        End If
                    End If
                End If
            End If
        Next
    End Sub

الف ألف مبروك

بارك الله

الف ألف مبروك

وعليكم السلام ..تفضل أخي الكريم

Book1.xlsx

ربما

تنشيط ورقة عمل.xlsm

مثال توضيحي.xlsx

سلمك الله

Sub test()
    Dim a As Variant, lr, i, x, s, k, itm
    a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 7)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> 0 Then
                If Not .exists(a(i, 1)) Then If a(i, 7) = Sheets(2).Range("C1") Then .Add a(i, 1), a(i, 7)
            End If
        Next
               Sheets(2).Cells(10, 1).Resize(.Count, 2) = Application.Transpose(Application.Index(Array(.keys, .items), 0, 0))
            End With
End Sub

أو

Sub test()
    Dim a As Variant, lr, i, x, s, k, itm
    a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 7)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> 0 Then
                If Not .exists(a(i, 1)) Then If a(i, 7) = Sheets(2).Range("C1") Then .Add a(i, 1), ""
            End If
        Next
               Sheets(2).Cells(10, 1).Resize(.Count) = Application.Transpose(.keys)
            End With
End Sub

عليكم السلام

ربما

Sub test()
    Dim a As Variant, lr, i, x, s, k, itm
    a = Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> 0 Then
                If Not .exists(a(i, 1)) Then
                    .Add a(i, 1), a(i, 3)
                Else
                If a(i, 3) <> "" Then .Item(a(i, 1)) = IIf(.Item(a(i, 1)) <> "", .Item(a(i, 1)) & "+" & a(i, 3), IIf(a(i, 3) <> "", a(i, 3), ""))
                End If
            End If
        Next
        itm = .items
         Sheets(2).Cells(2, 1).Resize(.Count, 2) = Application.Transpose(Application.Index(Array(.keys, .items), 0, 0))
    End With
End Sub

اضافة صفوف.xlsm

=COUNTIF(D2:N12,"<40")

F3=Round(C3/D3*E3;0)

المصنف1 (1).xlsx

ربما

=VLOOKUP($B4*1,INDIRECT("'"&$C$7&"'!"&"B9:F200"),5,0)

J43=VALUE(LEFT(I7,FIND("يومية",I7)-1))
J44=MID(I7,FIND(" و",I7)+2,FIND("ساعة",I7)-FIND(" و",I7)+2)