اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

أبو عبد الملك السوفي

04 عضو فضي
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    600

  • تاريخ الانضمام

  • تاريخ اخر زياره

 نوع المحتوي 

مشاركات المكتوبه بواسطه أبو عبد الملك السوفي

    الترحيل عند كتابة 13 رقم في خلية

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو عبد الملك السوفي

    الله اكبر عمل جد جد جدا رائع استاذ

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

    استاذي المطلوب هو  كما نبهتني اليه من قبل يجب ان لا يتكرر العامل بنفس الوقت بنفس التاريخ

    اي عند الترحيل اذا وجد نفس كود العامل ونفس التاريخ  لا يرحل

     

    الترحيل عند كتابة 13 رقم في خلية

    في منتدى الاكسيل Excel

    قام بنشر

    نعم استاذ نقطة التاريخ غفلت عنها ولم انتبه لها

    ولعلمك استاذ ادخال كود عامل يكون بجهاز الكود بار وانا لم اجرب الكود كع الجهاز

    وما اقصده عندما تكمل كتابة 13 رقم في الخلية يتم الترحيل قبل ان تكمل كتابة العدد14

    مثلا وضعت المؤشر في الخليةa3  وبدأت أكتب كود العامل 1234567891234 لما اكتب الرقم الاخير اريد تفعيل الكود بدون ان اضغط زر انتر الكود يعرف انه انتهت الكتابة في الخلية ويفعل الكود مباشره

    ارجوا ان اكون قد اوصلت الفكره

    والمقصود من هذا

    ان ادخال الارقام يكون بجهز الكود بار فاريد تفعيل الكود دون تدخل بشري

    الترحيل عند كتابة 13 رقم في خلية

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو عبد الملك السوفي

    السلام عليكم

    انا اعمل على برنامج تحضير العمال واريد فكرة عند كتابة 13 رقم في الخلية a3 من صفحة دخول العمال يتم الرحيل مباشرة الى صفحة التجميع دون الحاجة للضغط على ايقونة الترحيل

    بمعنى اخر عند كتابة 13 رقم في الخلية a3 يتم تفعيل كود الترحيل مباشرة دون تدخل

    افيدونا جزاكم الله خيرا

    برنامج مركز شمس للتسوق وتحضير العمال.rar

    مساعدة في تعديل كود ترحيل الى نفس المكان

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو عبد الملك السوفي

    جزاك الله خيرا استاذحاجي ونفع بك

    الهدف من الترحيل الى نفس السطر لان الاستمارة تملأ على مرحلتين

    المرحلة الاولة تملأ الييانات الاولى في الاستمارة ثم ترحل الى total

    اما المرحلة الثانية فيتم استدعاء الاستمارة واكمال المعلومات المتبيقة ثم ترحيلها

    لذا يجب ان تعدل في نفس السطر ولا يتغير مكانها

    والملف الاخير لم يفي بالغرض فهو ينقل الاستمارة المعدلة الى السطر ما قبل الاخير اي انه يحذف السطر الاخير وهو ليس المطلوب

    منذ 3 ايام او اكثر وانا احاول في تلك الجزئيه في الكود ولم انجح

    اخي سابعث لك الملف الاصلي الذي اخذت منه الكود فهو شغال وهو من اعداد الاستاذ محمود لعلك تفهم الية عمل الكود

    فاتورة جديدة6.rar

    مساعدة في تعديل كود ترحيل الى نفس المكان

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو عبد الملك السوفي

    السلام عليكم

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

    المطلوب

    هو تعديل الكود  

    Sub Tarheel()
'ÞÑÇÁÉ ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí
Dim d(19)
d(1) = [g6]: d(2) = [g2]: d(3) = [g3]: d(4) = [g4]: d(5) = [b8]: d(6) = [g8]: d(7) = [C13]: d(8) = [f13]: d(9) = [C18]: d(10) = [f19]: d(11) = [C20]: d(12) = [b23]:  d(13) = [B26]: d(14) = [c26]: d(15) = [B27]: d(16) = [c27]: d(17) = [b28]: d(18) = [c28]: d(19) = [c30]



' Check if this Invoice is exist
 With Sheets("total")
    LR = .[b10000].End(xlUp).Row
        For r = 4 To LR
            x = .Cells(r, 2).Value
            If x = [g6] Then GoTo 10     ' *** Found @ r (Row)***
        Next r
    GoTo 30                              ' NOT Found

10
        MsgBox ("ÇáÝÇÊæÑÉ ãæÌæÏÉ ãä ÞÈá" & Chr(10) & "ÓíÊã ÍÐÝåÇ ãä æÑÞÉ ÇáÈíÇäÇÊ æäÞáåÇ ãßÇä ÇáÞÏíãÉ")
        If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20
            n_LR = .[b10000].End(xlUp).Row
20          .Range("B" & r & ":G" & n_LR).EntireRow.Delete Shift:=xlUp
             
30
'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ

DR = .[b10000].End(xlUp).Row + 1         'ÂÎÑ ÕÝ ÈíÇäÇÊ ÌÇåÒ áÇÓÊáÇã ÈíÇäÇÊ ÌÏíÏÉ ÈÇáæÑÞÉ ÏÇÊÇ
    For i = 1 To 19
        .Cells(DR, i + 1) = d(i)
    Next i
End With

LR = [E31].End(xlUp).Row
'ÞÑÇÁÉ æäÞá ÇáÈíÇäÇÊ ÇáÃÑÈÚÉ ÇáÃÎíÑÉ


Sheets("mokalassa").Select
Reply = MsgBox("Êã ÊÑÍíá ÇáÝÇÊæÑÉ ÈÍãÏ Çááå" & Chr(10) & "åá ÊÑíÏ ãÓÍ ÇáÈíÇäÇÊ ãäåÇ", vbYesNo)
If Reply <> 6 Then Exit Sub
Range("g2") = [g3]
Range("g3") = "=NOW()"
Range("g4") = "=IF(HOUR(R[-1]C)>15,""ÇáãÓÇÆíÉ"",""ÇáÕÈÇÍíÉ"")"
Range("b8:e8").ClearContents
Range("g8").ClearContents
Range("c13:d13").ClearContents
Range("f13:g13").ClearContents
Range("c18:d18").ClearContents
Range("f19:g19").ClearContents
Range("c20:d20").ClearContents
[g6] = [g6] + 1
Range("b26:b28").ClearContents
Range("c26:g26").ClearContents
Range("c27:g27").ClearContents
Range("c28:g28").ClearContents
Range("c30:d30") = "=IF(R[-10]C="""","""",(R[-2]C[-1]+R[-3]C[-1]+R[-4]C[-1]+R[-10]C)-(R[-12]C+R[-17]C))"
Range("b23:c23") = "=IF(R[-3]C[1]="""","""",R[-3]C[1]-(R[-5]C[1]+R[-10]C[1]))"
End Sub

    فعند الرحيل اذا كان رقم الاستمارة موجود من قبل في صفحة total فانه يرحل الى نفس السطر وليس الى اخر سطر

    واضن ان الجزئية التاليه هي المقصودة بالتعديل 

    10
        MsgBox ("الفاتورة موجودة من قبل" & Chr(10) & "سيتم حذفها من وقة البيانت ونقلها من مكانها القديم")
        If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20
            n_LR = .[b10000].End(xlUp).Row
20          .Range("B" & r & ":G" & n_LR).EntireRow.Delete Shift:=xlUp

    برنامج مركز شمس للتسوق تحت التعديل.rar

    تعديل كود ترحيل

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو عبد الملك السوفي

    •  

    السلام عليكم جزاكم الله كل خير ونفع بكم

    من فضلكم اريد تعديل الكود التالي 

    Sub kh_trheel2014()
On Error Resume Next
Dim Ary
Dim M As Long, Mt As Long
Dim Txt As String
Txt = [C14] & [C8] & [C9] & [D10] & [G10] & [C12]
With shit4
    M = .Cells(.Rows.Count, "A").End(xlUp).Row
      Mt = WorksheetFunction.Match(Txt, .Range("L2").Resize(M), 0)
    If Mt Then
        If MsgBox("تم تويق البيانات من قبل " & vbCr & "هل تريد مواصلة التوثيق", vbYesNo, "تأكيد") = vbNo Then GoTo 1
    End If
    Ary = Array(M, [C14], [C8], [C9], [D10], [G10], [C12], [F14], [G5] & [H5] & [I5], [D18], [G16], Txt)
    .Cells(M + 1, 1).Resize(1, 12).Value = Ary
    MsgBox ("شكرا تم التويق")
  Range("C8:I8").ClearContents
 Range("C9:I9").ClearContents
 Range("D10:E10").ClearContents
 Range("G10:I10").ClearContents
 Range("C12:I12").ClearContents
 Range("C14:D14").ClearContents
 Range("F14:I14").ClearContents
 Range("D18:I18").ClearContents
End With
1:
End Sub

    والتغيير المطلوب هو عندما تكون نفس البيانات اريد من الكود ان يحفظ البيانات الجديدة في نفس المكان ولا يرحلها الى آخر سطر

    برنامج رشيد للشهادت المدرسية1.rar

    تعديل كود ترحيل

    في منتدى الاكسيل Excel

    قام بنشر

    السلام عليكم جزاكم الله كل خير ونفع بكم

    من فضلكم اريد تعديل الكود التالي 

    Sub kh_trheel2014()
On Error Resume Next
Dim Ary
Dim M As Long, Mt As Long
Dim Txt As String
Txt = [C14] & [C8] & [C9] & [D10] & [G10] & [C12]
With shit4
    M = .Cells(.Rows.Count, "A").End(xlUp).Row
      Mt = WorksheetFunction.Match(Txt, .Range("L2").Resize(M), 0)
    If Mt Then
        If MsgBox("تم تويق البيانات من قبل " & vbCr & "هل تريد مواصلة التوثيق", vbYesNo, "تأكيد") = vbNo Then GoTo 1
    End If
    Ary = Array(M, [C14], [C8], [C9], [D10], [G10], [C12], [F14], [G5] & [H5] & [I5], [D18], [G16], Txt)
    .Cells(M + 1, 1).Resize(1, 12).Value = Ary
    MsgBox ("شكرا تم التويق")
  Range("C8:I8").ClearContents
 Range("C9:I9").ClearContents
 Range("D10:E10").ClearContents
 Range("G10:I10").ClearContents
 Range("C12:I12").ClearContents
 Range("C14:D14").ClearContents
 Range("F14:I14").ClearContents
 Range("D18:I18").ClearContents
End With
1:
End Sub

    والتغيير المطلوب هو عندما تكون نفس البيانات اريد من الكود ان يحفظ البيانات الجديدة في نفس المكان ولا يرحلها الى آخر سطر

    مساعدة في تعديل بسيط في كود

    في منتدى الاكسيل Excel

    قام بنشر

    السلام عليكم

    عندي كود بعد ان يرحل يمسح محتويات الخلايا

    وهذا امر المسح

    Range("b8:e8").ClearContents

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

    ماذا افعل

     

    جزاكم الله كل خير استطعت التغلب عن الامر

    جزاكم الله كل خير استطعت التغلب على الامر

    جزاكم الله خيرا استطعت التغلب على الامر

    تعديل كود ترحيل

    في منتدى الاكسيل Excel

    قام بنشر

    السلام عليكم اسات\تنا الكرام

    هذا الكود من احد اساتذة المنتى جزاه الله خيرا

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

    Sub Tarheel()
'ÞÑÇÁÉ ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí
Dim d(17)
d(1) = [g2]: d(2) = [g3]: d(3) = [g4]: d(4) = [b8]: d(5) = [g8]: d(6) = [c13]: d(7) = [f13]: d(8) = [c18]: d(9) = [f19]: d(10) = [c20]: d(11) = [b23]: d(12) = [b26]: d(13) = [c26]: d(14) = [b27]: d(15) = [c27]: d(16) = [b28]: d(17) = [c28]

'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ
With Sheets("total")
    LR = .[a10000].End(xlUp).Row
        For r = 1 To LR
            x = .Cells(r, 1).Value
            If x = [v6] Then GoTo 20     ' *** Found @ r (Row)***
        Next r
    GoTo 10                              ' NOT Found

10
        MsgBox ("ÇáÝÇÊæÑÉ ãæÌæÏÉ ãä ÞÈá" & Chr(10) & "ÓíÊã ÍÐÝåÇ ãä æÑÞÉ ÇáÈíÇäÇÊ æäÞáåÇ Åáí ÂÎÑ ÇáæÑÞÉ")
        If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20
            n_LR = .[i10000].End(xlUp).Row
20          .Range("a" & r & ":u" & n_LR).EntireRow.Delete Shift:=xlUp
             
30
'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ

DR = .[b10000].End(xlUp).Row + 1         'ÂÎÑ ÕÝ ÈíÇäÇÊ ÌÇåÒ áÇÓÊáÇã ÈíÇäÇÊ ÌÏíÏÉ ÈÇáæÑÞÉ ÏÇÊÇ
    For i = 1 To 17
        .Cells(DR, i + 1) = d(i)
    Next i
End With

LR = [E30].End(xlUp).Row

Sheets("mokalassa").Select
Reply = MsgBox("Êã ÊÑÍíá ÇáÝÇÊæÑÉ ÈÍãÏ Çááå" & Chr(10) & "åá ÊÑíÏ ãÓÍ ÇáÈíÇäÇÊ ãäåÇ", vbYesNo)
If Reply <> 6 Then Exit Sub
Range("G2").ClearContents
Range("G3").ClearContents
Range("G4").ClearContents
Range("b8:e8").ClearContents
Range("g8").ClearContents
Range("c13:d13").ClearContents
Range("f13:g13").ClearContents
Range("c18:d18").ClearContents
Range("f19:g19").ClearContents
Range("c20:d20").ClearContents
Range("b23:c23").ClearContents
[g6] = [g6] + 1
Range("b26:b28").ClearContents
Range("c26:g26").ClearContents
Range("c27:g27").ClearContents
Range("c28:g28").ClearContents

End Sub

    ولا ينقلها الى اخر سطر

    برنامج المخالصة2017.rar

×
×
  • اضف...

Important Information

  I accept