اضافة شرط عند عد الحالات .. استكمال لموضوع سابق

[عادل ابوزيد]

السلام عليكم 

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

الملف عبارة عن حالات بارقام تقوم بزيارة المكان وعمل تقرير لها فى بعض الزيارات وكل زيارة يكتب فيها تقرير يتم استيفاء خانة رقم الصادر 

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

 

تقرير الحالات.rar الملف بعد التعديل 2.rar

تم تعديل ديسمبر 11, 2023 بواسطه عادل ابوزيد

[محمد هشام.]

Sub test()
Dim j(1 To 2) As String
Dim WSData As Worksheet:     Set WSData = Sheets("البداية")
Dim F As Variant:            Set r = WSData.Range("E7:E" & Range("E" & Rows.Count).End(xlUp).Row)
Dim arr() As Variant:        arr = r.Value2: F = r.Offset(, 8).Value2
Dim col() As Variant:        ReDim col(1 To UBound(arr), 1 To 1)

  j(1) = Application.ActiveWorkbook.Path & "\تقرير الحالات\"
     j(2) = Dir(j(1))
         If j(2) = "" Then
         
MsgBox "يتعدر العثور على مجلد تقرير الحالات ", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه"
 Else

Application.ScreenUpdating = False

WSData.Range("F7", Range("F" & Rows.Count).End(4)).ClearContents
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
  If VBA.Len(F(i, 1)) > 0 And (arr(i, 1)) > 0 Then
        If Not .Exists(arr(i, 1)) Then
            .Add arr(i, 1), 1
            col(i, 1) = arr(i, 1)
        Else
            .Item(arr(i, 1)) = .Item(arr(i, 1)) + 1
            col(i, 1) = arr(i, 1) & " (" & .Item(arr(i, 1)) & ")"

        End If
        End If
    Next i
        r.Offset(, 1).Value2 = col
End With
Application.ScreenUpdating = True
End If
End Sub

 

 

تم تعديل ديسمبر 12, 2023 بواسطه محمد هشام.

[عادل ابوزيد]

السلام عليكم 

ما شاء الله عليكم يا استاذ محمد ابداع تسلم ايدك

تم اضافة الكود للملف الاصلى 

هل يمكن اضافة البحث داخل اليوزرفورم بحيث يتم البحث بجزء من رقم الحالة

وهل يمكن فى حالة عدم وجود التقرير بسبب نسيان او عدم اكتمال رفع التقرير من المسئول عن رفع التقرير يظهر رسالة تفيد عدم وجود التقرير للحالات التى لم يرفع لها تقرير

تقبل تحياتى وشكرى وتقديرى

الملف به الكود الجديد بعد شرط الصادر.xls

[عادل ابوزيد]

لمن يريد ان يتابع الموضوع من اوله رابط الموضوع الاول