جعفر الطريبق

نعم كل ما تحتاج هو تبديل "نعم" ب "لا"   و هكدا  ....

Sub Test()
    MsgBox CountIf(Range("A1:H20"), "نعم")
	MsgBox CountIf(Range("A1:H20"), "لا")
End Sub

Function CountNonEmpty(ByVal Rng As Range) As Long
    CountNonEmpty = WorksheetFunction.CountA(Rng)
End Function

Function CountIf(ByVal Rng As Range, ByVal Val As Variant) As Long
    CountIf = WorksheetFunction.CountIf(Rng, Val)
End Function

Sub Test()
    MsgBox CountNonEmpty(Range("A1:H20"))
    MsgBox CountIf(Range("A1:H20"), "نعم")
End Sub

ردا على السيد يوسف السيد

لا أدري لمادا يعطيك الخطأ ... صعب معرفة المشكلة

لو الكود يتوقف Debugger  في خط ما ممكن يساعدك على معرفة المشكلة 

قبل أيام انتهيت من كتابة كود يفعل سكرول بمجرد وضع الماوس فوق أي كونترول و تحريك عجلة الماوس

السكرول الأفقي يتم تفعيله لو المفتاح Ctrl Key مضغوط ...

https://app.box.com/s/ese76vt2hinumy7flss2ovc11psqizyd

الكود لا يشتغل في 64Bit Office 2010 x 64

افرض عندك قائمة طويلة في احدى أعمدة الاكسيل و تحتوي هده القائمة على 5000 اسم  مثلا .. و في مكان أخر هنالك خلية تستعمل لادخال اسم من الأسماء الموجودة بالقائمة .. هدا السيناريو يحتاج في الغالب الى قائمة منسدلة Data Validation List لتفادي الادخال في الخلية أسماء غير موجودة على القائمة ... هدا حل جيد لكنه بطيئ حيث يتطلب من المستخدم البحث بين 5000 اسم بواسطة شريطScrollBar

قبل أشهر كتبت هدا الكود الدي يستدعي و يفلتر الأسماء أليا بمجرد بدأ كتابة الأحرف الأولى  ... ملف للتحميل : https://app.box.com/s/v6uamjb6tad3ozs6ajw0bnt61292ja7v

طريقة العمل  :

1- Activate the Input Cell

2 - Press F1 Key to bring up the list

3 - ... Start Typing in and the list will get filtered automatically based on the letters you have typed

4 -  Press Enter Key or use the Down /Up Arrow navigation Keys when the searched Item is found or Press the ESC Key to Cancel the whole operation

لا تستعمل Application.InputBox

افضل استعمال vba.InputBox

Private Sub CommandButton1_Click()
Unload Me
End Sub




Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Dim rng As Range, LR As Long
Dim x
x = InputBox("Please enter a Quntity")
If x = False Or StrPtr(x) = 0 Or Not IsNumeric(x) Then
    Exit Sub
Else
LR = Sheets("invoice").Cells(Rows.Count, "E").End(xlUp).Row + 1
Set rng = Sheets("invoice").Cells(LR, 4)
    
If ListBox1.Value <> "" Then
rng.Value = ListBox1.Value
rng.Offset(0, 1).Value = ListBox1.List(ListBox1.ListIndex, 1)
rng.Offset(0, 4).Value = ListBox1.List(ListBox1.ListIndex, 2)
rng.Offset(0, 2).Value = x
End If
End If
End If
End Sub

Private Sub TextBox1_Change()
Dim LR As Integer, R As Integer, T As Integer
ListBox1.Clear
With Sheets("Codes")
    LR = .Cells(.Rows.Count, 2).End(xlUp).Row
    For R = 2 To LR
        If .Cells(R, 2) Like "*" & TextBox1.Text & "*" Then
            ListBox1.AddItem
            ListBox1.List(T, 0) = .Cells(R, 1)
            ListBox1.List(T, 1) = .Cells(R, 2)
            ListBox1.List(T, 2) = .Cells(R, 4)
            ListBox1.List(T, 3) = .Cells(R, 5)
            T = T + 1
        End If
    Next
End With
End Sub


Private Sub UserForm_Activate()
TextBox1_Change
ListBox1.ListIndex = 0
End Sub

 ممكن تنشر الكود الموجود في الفورم  و الكود في ScrollWheel module  ... و ممكن تقول لنا نسخة الاكسيل التي تستعملها و نسخة الويندوز

عند حماية الصفحة اضغط على البوكس Use Automatic Filter

هل تتحدث عن شكل على صفحة الاكسيل مثل star shape

شكرا على ترحيبكم و كلماتكم الطيبة   ... العضو الكريم السيد *ياسر خليل* هو من استضافني في هدا المنتدى

لا يمكن فتح ملف اكسيل بدون ظهور برنامج الاكسيل على الشاشة لبضع ثواني ثم  بعد دالك يقوم الكود باخفاء نافدة الاكسيل و اظهار الفورم ...

لكن يمكن انشاء برنامج بسيط و صغير بالفيجوال بازيك  VB6 .exe و ادماج ملف الاكسيل داخله  (ADS file) .. و عند فتح برنامج الفيجوال بيزيك يقوم هدا الأخير بفتح ملف الاكسيل وراء الستار دون الظهور على الشاشة ثم يقوم باظهار الفورم

اين هي مخزنة لائحة الأسماء و الكودات ...

Sub SortSheets()
    Dim I As Integer, J As Integer

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If Val(Sheets(I).Name) > Val(Sheets(J).Name) Then
                Sheets(J).Move Before:=Sheets(I)
            End If
        Next J
    Next I
End Sub