أكاديمية الصقر للتدريب


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات

السلام عليكم ورحمة الله وبركاته الاخوه الكرام اكنت عاوز مساعدتكم فى الملف ده انا راجعته وطلعت منه النتائج الموجوده فى ا ..


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


02-05-2022 10:12 مساء
Lotfy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 07-12-2019
رقم العضوية : 16447
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 8-6-1976
قوة السمعة : 22
 offline 

السلام عليكم ورحمة الله وبركاته الاخوه الكرام اكنت عاوز مساعدتكم فى الملف ده انا راجعته  وطلعت منه النتائج الموجوده فى العمود  N و العمود O و العمود P   والموضوع ده  هيتكرر على 320 ملف الى انا براجعه وبعدين باخد النتائج ده وارحلها الى ملف المراجعه النهائية مدونه فى ملحوظه الى العمود H  فى ملف المراجعه  بالنسبه للعمود N  باخد الناتج الموجود  فى الخليه N5  واكتب ملحوظه ثابته مكرره وهى ( فاتوره رقم 2576 بتاريخ 2019/10/3 بمبلغ 673.20 لا يوجد لها فاتوره و فاتوره رقم 34668 بتاريخ 2020/3/1 بمبلغ 791.7 لا يوجد لها فاتوره فاتوره رقم 73114 بتاريخ 2020/8/2 بمبلغ 841.4 لا يوجد لها فاتوره) وبالنسبه للعمود O  وأكتب ملحوظه ثابته مكرره وهى ( فاتورة رقم 18745 بتاريخ 2020/1/1 لم يخصم نسبة التعاقد بمبلغ 59.25 ) وبالنسبه للعمود P  وأكتب ملحوظه ثابته مكرره وهى (فاتورة رقم 84897 بتاريخ 2020/9/2 بملغ 841.40 يوجد ملاحظة  x على كامل الفاتورة) وبالنسبه للمبالغ الموجوده فى العمود N بجمعها واضيفها  وارحلها الى ملف المراجعة النهائية فى  العمود G  وعنوانه  (خصم تحت التسوية) وبالنسبه للمبالغ الموجوده فى العمود O  بجمعها واضيفها  وارحلها الى ملف المراجعة النهائية فى  العمود F  وعنوانه  (خصم تعاقد) وبالنسبه للمبالغ الموجوده فى العمود P  بجمعها واضيفها  وارحلها الى ملف المراجعة النهائية فى  العمود E  وعنوانه  (خصم فنى من الشركة)   ملحوظه رقم الفاتورة ثابت فى العمود E  والتاريخ ثابت فى العمود G  فى كل ملفات التى براجعها
 
 
  2179.xlsx   تحميل xlsx مرات التحميل :(4)
الحجم :(25.991) KB
  المراجعة النهائية.xlsb   تحميل xlsb مرات التحميل :(8)
الحجم :(28.441) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
جرب الكود التالي بعد التعديل 
Sub Test()
    Dim x, wb As Workbook, wbRevision As Workbook, wbClient As Workbook, ws As Worksheet, sh As Worksheet, f As Boolean, c As Range, sTemp As String, sBill As String, t1 As Double, t2 As Double, t3 As Double
    Application.ScreenUpdating = False
        Set wbRevision = ThisWorkbook
        Set sh = wbRevision.Worksheets(1)
        For Each wb In Application.Workbooks
            If wb.Name <> wbRevision.Name Then f = True: Set wbClient = wb: Exit For
        Next wb
        If f = False Then MsgBox "Open The Client Workbook", vbExclamation: Exit Sub
        Set ws = wbClient.Worksheets(1)
        sBill = vbNullString: t1 = 0: t2 = 0: t3 = 0
        If Application.CountA(ws.Columns("N")) > 0 Then
            For Each c In ws.Columns("N").SpecialCells(xlCellTypeFormulas).Cells
                sTemp = vbNullString
                sTemp = "فاتورة رقم " & c.Offset(, -9).Value & " بتاريخ " & Format(c.Offset(, -7).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " لا يوجد لها فاتورة"
                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
                t1 = t1 + Application.WorksheetFunction.Round(c.Value, 1)
            Next c
        End If
        If Application.CountA(ws.Columns("O")) > 0 Then
            For Each c In ws.Columns("O").SpecialCells(xlCellTypeConstants).Cells
                sTemp = vbNullString
                sTemp = "فاتورة رقم " & c.Offset(, -10).Value & " بتاريخ " & Format(c.Offset(, -8).Value, "yyyy/mm/dd") & " لم يخصم نسبة التعاقد بمبلغ " & c.Value
                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
                t2 = t2 + c.Value
            Next c
        End If
        If Application.CountA(ws.Columns("P")) > 0 Then
            For Each c In ws.Columns("P").SpecialCells(xlCellTypeFormulas).Cells
                sTemp = vbNullString
                sTemp = "فاتورة رقم " & c.Offset(, -11).Value & " بتاريخ " & Format(c.Offset(, -9).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " يوجد ملاحظة × على كامل الفاتورة"
                sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
                t3 = t3 + Application.WorksheetFunction.Round(c.Value, 1)
            Next c
        End If
        With sh
            x = Application.Match(Val(Split(wbClient.Name, ".")(0)), .Columns(1), 0)
            If Not IsError(x) Then
                .Cells(x, 5).Resize(, 4).Value = Array(IIf(t3 = 0, Empty, t3), IIf(t2 = 0, Empty, t2), IIf(t1 = 0, Empty, t1), sBill)
                Application.Goto .Cells(x, 1), True
                MsgBox "Done Successfully", 64, "YasserKhalil Excel-Egy"
            End If
        End With
    Application.ScreenUpdating = True
End Sub
عرض الإجابة






02-05-2022 10:49 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10432
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36232
عدد الإجابات: 247
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
وعليكم السلام أخي الكريم
اعذرني طرحك للموضوع غير واضح على الإطلاق
يمكنك تناول نقطة واحدة في الموضوع حتى إذا تمت بشكل جيد قمت بطرح موضوع آخر لتستطيع الوصول للحل النهائي
بشكل مبدئي قلت أنك وضعت النتائج في الملف المسمى 2179 في الأعمدة N - O - P فهل تريد أن تضع النتائج بالكود أم ماذا ؟ وفي حالة كان ردك أنك تريد النتائج بالكود ، ما هو المنطق في استخراج النتائج بالضبط 


02-05-2022 11:10 مساء
مشاهدة مشاركة منفردة [2]
Lotfy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 07-12-2019
رقم العضوية : 16447
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 8-6-1976
قوة السمعة : 22
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
استاذ ياسر أنا سعيد جدا بمرورك الكريم كل عام وحضرتك وجميع الاخوه الأفاضل بالف خير 
حضرتك أنا معايا ٣٢٠ ملف كلهم زى الملف  ٢١٧٩ وبالتنسيق وممكن بعضهم يزيد فى عدد الصفوف أما الاعمده فهى ثابتة وبها نفس البيانات ونفس العناوين
لما بفتح ملف  وبعد ما براجع فيه وبطلع النتائج فى الأعمدة nوoوp  بروح على الملف (المراجعة النهائية) وهذا الملف بيكون مفتوح على طول المراجعة بحيث أما بخلص مراجعة ملف بكتب الملاحظات ويضيف المبالغ فى الأعمدة GوFوE
وبالنسبة للعمود H بكتب فيه ملاحظات كل عمود والملاحظات متشابهة بيختلف بس رقم الفاتورة والتاريخ والمبلغ والثلاث اعمده بجمعهم فى الثلاث اعمده الموجودة في ملف المراجعة النهائية فهل فى طريقه بالاكواد يتم الترحيل وكتابة الملاحظات بدلاله المبالغ الموجودة في الثلاث اعمده 


02-05-2022 11:32 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10432
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36232
عدد الإجابات: 247
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
لاحظت في العمود N معادلات وفي العمود P معادلات أما في العمود O قيم .. هل الأمر ثابت؟
أقصد هل كل القيم في الثلاثة أعمدة عبارة عن معادلات أم أن العمود الأوسط قيم والعمودين الآخرين معادلات؟


02-05-2022 11:41 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10432
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36232
عدد الإجابات: 247
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
جرب الكود التالي وإن شاء الله يفي بالغرض
ملفات الإكسيل المفتوحة فقط ملف المراجعة النهائية وملف العميل (الملف الذي تقوم بمراجعته) ، وأغلق أي ملفات أخرى
قم بوضع الكود في الملف (المراجعة النهائية) .. ادرس الكود بشكل جيد وغير ما يلزم ليناسب عملك
Sub Test()
    Dim x, wb As Workbook, wbRevision As Workbook, wbClient As Workbook, f As Boolean, c As Range, sTemp As String, sBill As String, t1 As Double, t2 As Double, t3 As Double
    Application.ScreenUpdating = False
        Set wbRevision = ThisWorkbook
        For Each wb In Application.Workbooks
            If wb.Name <> wbRevision.Name Then f = True: Set wbClient = wb: Exit For
        Next wb
        If f = False Then MsgBox "Open The Client Workbook", vbExclamation: Exit Sub
        sBill = vbNullString: t1 = 0: t2 = 0: t3 = 0
        For Each c In wbClient.Worksheets(1).Columns("N").SpecialCells(xlCellTypeFormulas).Cells
            sTemp = vbNullString
            sTemp = "فاتورة رقم " & c.Offset(, -9).Value & " بتاريخ " & Format(c.Offset(, -7).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " لا يوجد لها فاتورة"
            sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
            t1 = t1 + Application.WorksheetFunction.Round(c.Value, 1)
        Next c
        For Each c In wbClient.Worksheets(1).Columns("O").SpecialCells(xlCellTypeConstants).Cells
            sTemp = vbNullString
            sTemp = "فاتورة رقم " & c.Offset(, -10).Value & " بتاريخ " & Format(c.Offset(, -8).Value, "yyyy/mm/dd") & " لم يخصم نسبة التعاقد بمبلغ " & c.Value
            sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
            t2 = t2 + c.Value
        Next c
        For Each c In wbClient.Worksheets(1).Columns("P").SpecialCells(xlCellTypeFormulas).Cells
            sTemp = vbNullString
            sTemp = "فاتورة رقم " & c.Offset(, -11).Value & " بتاريخ " & Format(c.Offset(, -9).Value, "yyyy/mm/dd") & " بمبلغ " & Application.WorksheetFunction.Round(c.Value, 1) & " يوجد ملاحظة × على كامل الفاتورة"
            sBill = sBill & IIf(sBill <> "", " - ", "") & sTemp
            t3 = t3 + Application.WorksheetFunction.Round(c.Value, 1)
        Next c
        With wbRevision.Worksheets(1)
        x = Application.Match(Val(Split(wbClient.Name, ".")(0)), .Columns(1), 0)
        If Not IsError(x) Then
            .Cells(x, 5).Resize(, 4).Value = Array(t3, t2, t1, sBill)
            Application.Goto .Cells(x, 1), True
            MsgBox "Done Successfully", 64, "YasserKhalil Excel-Egy"
        End If
        End With
    Application.ScreenUpdating = True
End Sub


03-05-2022 12:55 صباحا
مشاهدة مشاركة منفردة [5]
Lotfy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 07-12-2019
رقم العضوية : 16447
المشاركات : 13
الجنس : ذكر
تاريخ الميلاد : 8-6-1976
قوة السمعة : 22
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
الحمد لله استاذ ياسرخليل بارك الله فى حضرتك  الكود اشتغل معايا وجايب معايه نتيجة مائه فى المائه  يارب يجعله فى ميزان حسناتك  اللهم امين يارب العالمين
هو حضرتك العمود N  اشتغل اما خليت الخلايا الموجوده معادلات هو العمود O  بيشتغل من غير معادلات قيم بس
 


03-05-2022 07:18 صباحا
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10432
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36232
عدد الإجابات: 247
 offline 
look/images/icons/i1.gif ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات
الحمد لله الذي بنعمته تتم الصالحات
لو لاحظت في الكود ستجد ثلاثة حلقات تكرارية لكل عمود وفي نهاية السطر لكل حلقة ستجد  xlCellTypeFormulas في حالة التعامل مع الخلايا التي بها معادلات ، ما عدا العمود الأوسط .. غير في الكود يما يتناسب معك


الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
ترحيل ، بيانات ، خلايا ، مختلفه ، ملفت ، واحد ، كتابة ، الملاحظات ، التى ، ترحيل ، البيانات ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 01:04 صباحا