ترحيل صفوف مع عدم التكرار بتحقق شرط معين فى الشيت المقابل لشرط البحث

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

السلام عليكم ورحمه الله وبركاته

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

ويتم الترحيل الى 4 صفحات حسب الادارة (المستحقين ، الاحياء ، التفتيش ، اخرى ) صفحة المستحقين اذا كان الخانة بعمود الادارة مستحقين ، ويتم الترحيل الى صفحة الاحياء اذا كانت الحانة بعمود الادارة احياء .. الخ

مع كتابة تاريخ الترحيل بالخانة المجاورة لخانة الادارة ( تاريخ الدخول للقسم ) 

تم ترحيل بعض البيانات يدوياً لتوضيح الموضوع وبرجاء النظر إلى عمود المسلسل فى الصفحات المرحل إليها للتوضيح اكثر 

 

ترحيل الصفوف مع عدم التكرار بتحقق شرط.rar

تم تعديل ديسمبر 6 بواسطه عادل ابوزيد

[عبدالله بشير عبدالله]

وعليكم السلام ورحمة الله وبركاته

قم بتجربة الملف 

اسماء الادارة يجل ان تكون نفسها اسماء الشبتات 

نم نعديل مستحقين الى المستحقين 

الكود في حدث الورقة

ترحيل الصفوف مع عدم التكرار بتحقق شرط.zip

 

 

تم تعديل ديسمبر 6 بواسطه عبدالله بشير عبدالله

[محمد هشام.]

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

Option Explicit
Sub test()
    Dim Sh As Worksheet, WS As Worksheet: Set WS = Worksheets("واردالمنطقة")
    Dim iRow As Long, Rng As Range, dstRng As Long, lastRow As Long, Cnt As String, Updated As Boolean
    Dim tmp As String, j As Boolean, cell As Range, WSname As String, ky As String, n As String

    Cnt = "=SUBTOTAL(103,INDIRECT(ADDRESS(ROW(),COLUMN()+1)&"" :""&ADDRESS(ROW($E$7),COLUMN()+1)))"
    Updated = False

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> WS.Name Then
            WSname = Sh.Name: ky = Replace(WSname, "ال", "")
            For iRow = 7 To WS.Range("R" & WS.Rows.Count).End(xlUp).Row
                n = WS.Cells(iRow, "R").Value
                If InStr(1, n, ky, vbTextCompare) > 0 And n <> "" Then
                    tmp = WS.Cells(iRow, "E").Value
                    j = False
                    For Each cell In Sh.Range("E7:E" & Sh.Rows.Count)
                        If cell.Value = tmp Then
                            j = True
                            Exit For
                        End If
                    Next cell
                    
                    If Not j Then
                        Set Rng = WS.Range(WS.Cells(iRow, 2), WS.Cells(iRow, 28))
                        dstRng = Sh.Cells(Sh.Rows.Count, "E").End(xlUp).Row + 1
                        If dstRng < 7 Then dstRng = 7
                        Sh.Cells(dstRng, "B").Resize(, 27).Value = Rng.Value
                        Sh.Cells(dstRng, "D").Value = Date
                        lastRow = Sh.Cells(Sh.Rows.Count, "B").End(xlUp).Row
                        Sh.Cells(lastRow, "B").Formula = Cnt
                        Updated = True
                    End If
                End If
            Next iRow
        End If
    Next Sh
    MsgBox IIf(Updated, "تم ترحيل البيانات بنجاح", "جميع البيانات محدثة مسبقا"), vbInformation, "تعليمات"
                      
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

 

 

ترحيل الصفوف مع عدم التكرار بتحقق شرط v2.rar

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

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

الاساتذة الافاضل ... عبد الله بشير عبد الله .. محمد هشام

افاض عليكم الله بكرمه ونعمه وواسع فضله 

جزاكم الله كل خير 

بفضل مساهماتكم الكريم تم حل اولى خطوات العمل ... وهذا الملف سيكون فى ادارة الوارد والتى تقوم بتسجيل الملفات وتوزيعها على الاربع ادارات ( الاحياء ، المستحقين ، التفتيش ، اخرى )

المشكلة الثانية وهى ان كل ادارة يجب ان تستلم الملفات مع كل تحديث 

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

[محمد هشام.]

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

 

2) المرحلة الثانية غير واضحة بالنسبة لي يرجى شرحها بشكل أدق أو إرفاق عينة للنتائج المتوقعة ربما نستطيع مساعدتك 

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

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

السلام عليكم .. استكمالاً للعمل 

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

للتوضيح تم وضع مخطط عمل

توضيح.doc

تم تعديل ديسمبر 6 بواسطه عادل ابوزيد