طلب مساعده - مشكله في الاكسل

[ا بو سليمان]

لدي اعمدة في صفحة اكسل   

 

هذه الاعمدة ذات قيمة مغيرة كل يوم  

 

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

 

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

 

مثال قيمة  العمود  أ  = 10  يوم السبت 

 

ارغب  ان تنتقل هذه القيمة الى العمود المجاور له  ليصبح العمود ب  =10    والعمود  أ  يحوي قيمة جديده ولنفترض انها 40  و و يوم الاحد

 

وبهذا فان يوم الاثنين  يكون العمود ج  =  10

العمود ب =40

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

 

وهكذا 

 

===========

 

ملاحظة 

 

بيانات  العمود الاول   نحن ندخلها  يدويا    المطلوب هو ان تنتقل هذه البيانات تلقائيا  كل يوم الى العمود الذي بجانبه

 

 

شكرا لكم  مقدما

 

 

[شوقي ربيع]

تفضل

Sub test()
Dim lr As Long, Lrr As Long
Dim R As Integer, iCont As Integer
Dim xx As Double

lr = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
For R = 1 To lr
    xx = Feuil1.Cells(R, 1)
    iCont = WorksheetFunction.CountIf(Feuil2.Columns(R), xx)
If xx <> 0 Then
If iCont > 0 Or Feuil2.Cells(R, 1) = xx Then GoTo RabieCont
    Feuil2.Cells(R, 1) = xx
If Feuil1.Cells(R, 2) = "" Then
Feuil1.Cells(R, "A").Resize(1, 2).Copy Cells(R, "B")
Else
lc = Feuil1.Cells(R, Rows.Column).End(xlToRight).Column
Feuil1.Cells(R, "A").Resize(1, lc).Copy Cells(R, "B")
End If
RabieCont:
End If
Next

End Sub

rabie.rar

[ا بو سليمان]

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

 

يا  عسل   الملف فيه مشكلتين

 

الاولى عندما يتم تكرار الرقم  المدخل في العمود الاول  فانه بعد التكرار الثاني  يتوقف  العمل فهو لا يقبل  ........ مثال  ادخال  رقم  5  ثم   5  ثم 5  وهكذا 

 

لا يقبل الا عندما ادخل  5  ثم  5  ثم رقم مغاير غير رقم 5  مفترض  3 او  ااي رقم وهكذا ....

 

ثانيا

 

ارغب ان يتحدث  العمود الاول تلقائي  بعد تاريخ  معين     من الساعة الخامسة  مساء  يتغير وينقل  الى  الخانه الثانيه    (( يعني لو تغير الخانه في العمود الاول  قبل الخامسة مساء  مطلوب انه لا يتغير  

 

ارغب ان يقبل التغير لمره واحد  فقط باليوم  فلو مثلا  اخطات انا وادخلت  مرتين    فهو لا يقبل الا مره واحده

 

 

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

 

 

والسؤال ايضا

 

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

 

 

 

وقبل  وبعد كل  شي 

 

انا في غايه الامتنان لك 

تم تعديل يوليو 28, 2013 بواسطه zmzm

[شوقي ربيع]

السلام عليكم

تفضل 

Option Explicit
Sub TEST()
Dim Sh As Worksheet
Dim lr As Long, Lc As Long
Dim r As Integer, iCont As Integer
Dim xx As Double
Dim T, TT

T = Time$
If T <= "17:00:00" Then
    Set Sh = ThisWorkbook.Sheets("feuil1")
    lr = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    Lc = Sh.Cells(1, Rows.Column).End(xlToRight).Column
    If Sh.Cells(1, Lc) = Date Then
        MsgBox "áÇíãßäß ÊÛííÑ ÇáÈíäÇÊ áÇßËÑ ãä ãÑÉ æÇÍÏÉ ÞãÊ ÈÇáÝÚá ÈÊÛííÑ ÇáÈíäÇÊ áåÐÇ Çáíæã"
        Else
            For r = 2 To lr
        Lc = Sh.Cells(r, Rows.Column).End(xlToRight).Column
        If Sh.Cells(r, 2) = "" Then
        Sh.Cells(1, 2) = Date
        Sh.Range("A" & r).Resize(1, 2).Copy Sh.Range("B" & r)
    Else
        Sh.Cells(1, Lc + 1) = Date
        Sh.Range("A" & r).Resize(1, Lc).Copy Sh.Range("B" & r)
        End If
            Next
    End If
Else
MsgBox "áÇíãßäß ÇÌÑÇÁ ÚãáíÉ ÇÏÎÇá ÌÏíÏÉ ÇáÇ ÈÚÏ ÇáÓÇÚÉ ÇáÎÇãÓÉ ãÓÇÁ"
End If

End Sub

rabie.rar

[شوقي ربيع]

استبدل الكود الذي في الملف بهاذا الكود فهو افضل واصح

Option Explicit
Sub TEST()
Dim Sh As Worksheet
Dim lr As Long, Lc As Long
Dim r As Integer, iCont As Integer
Dim xx As Double
Dim T, TT

T = Time$
If T <= "17:00:00" Then
    Set Sh = ThisWorkbook.Sheets("feuil1")
    lr = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    If Sh.Range("B1") = Date Then
        MsgBox "áÇíãßäß ÊÛííÑ ÇáÈíäÇÊ áÇßËÑ ãä ãÑÉ æÇÍÏÉ ÞãÊ ÈÇáÝÚá ÈÊÛííÑ ÇáÈíäÇÊ áåÐÇ Çáíæã"
        Else
            For r = 1 To lr
        Lc = Sh.Cells(r, Rows.Column).End(xlToRight).Column
        If Sh.Cells(r, 2) = "" Then
        Sh.Cells(1, 2) = Date
        Sh.Range("A" & r).Resize(1, 2).Copy Sh.Range("B" & r)
    Else
        Sh.Range("A" & r).Resize(1, Lc).Copy Sh.Range("B" & r)
        Sh.Range("B1") = Date
        End If
            Next
    End If
Else
MsgBox "áÇíãßäß ÇÌÑÇÁ ÚãáíÉ ÇÏÎÇá ÌÏíÏÉ ÇáÇ ÈÚÏ ÇáÓÇÚÉ ÇáÎÇãÓÉ ãÓÇÁ"
End If

End Sub

[ا بو سليمان]

 

استبدل الكود الذي في الملف بهاذا الكود فهو افضل واصح

Option Explicit
Sub TEST()
Dim Sh As Worksheet
Dim lr As Long, Lc As Long
Dim r As Integer, iCont As Integer
Dim xx As Double
Dim T, TT

T = Time$
If T <= "17:00:00" Then
    Set Sh = ThisWorkbook.Sheets("feuil1")
    lr = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    If Sh.Range("B1") = Date Then
        MsgBox "áÇíãßäß ÊÛííÑ ÇáÈíäÇÊ áÇßËÑ ãä ãÑÉ æÇÍÏÉ ÞãÊ ÈÇáÝÚá ÈÊÛííÑ ÇáÈíäÇÊ áåÐÇ Çáíæã"
        Else
            For r = 1 To lr
        Lc = Sh.Cells(r, Rows.Column).End(xlToRight).Column
        If Sh.Cells(r, 2) = "" Then
        Sh.Cells(1, 2) = Date
        Sh.Range("A" & r).Resize(1, 2).Copy Sh.Range("B" & r)
    Else
        Sh.Range("A" & r).Resize(1, Lc).Copy Sh.Range("B" & r)
        Sh.Range("B1") = Date
        End If
            Next
    End If
Else
MsgBox "áÇíãßäß ÇÌÑÇÁ ÚãáíÉ ÇÏÎÇá ÌÏíÏÉ ÇáÇ ÈÚÏ ÇáÓÇÚÉ ÇáÎÇãÓÉ ãÓÇÁ"
End If

End Sub

اخي الفاضل شوقي ربيع  

 

انا في غايه الامتنان لك وحقيقة انك ساعتدني كثيرا  فلك جزيل الشكر و الاحترام 

 

 

سوف اعمل على التعديل الاخير الذي ساعتدني به وعندما تواجنهني مشكله سوف اكتبها بهذا الموضوع

 

شكرا  لك مره اخري 

[ا بو سليمان]

لم استطيع تطبيقه على هذا الملف 

 

لانني ارغب  بان يكون كل عمود ملون بلون اخضر (  اعلى - ادني - فتح  - اقفال سابق   - الحجم -        .........)  يكون في صفحة  مستقله  وي%

[ا بو سليمان]

لم استطيع تطبيقه على هذا الملف 

 

لانني ارغب  بان يكون كل عمود ملون بلون اخضر (  اعلى - ادني - فتح  - اقفال سابق   - الحجم -        .........)  يكون في صفحة  مستقله  ويتم في نفس الصفحة ترحيل قيمة  العمود بنفس الصفحة  الى  50  يوم بشكل  افقي  

 

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

 

لانني ارغب  بان احصل على متوسط  ايام  لمدة 50  يوم  لكل عمود  من اعمدة  اللون الاخضر 

 

 

شكرا مقدما احبتنا الافاضل

[ا بو سليمان]

لم استطيع تطبيقه على هذا الملف 

 

لانني ارغب  بان يكون كل عمود ملون بلون اخضر (  اعلى - ادني - فتح  - اقفال سابق   - الحجم -        .........)  يكون في صفحة  مستقله  ويتم في نفس الصفحة ترحيل قيمة  العمود بنفس الصفحة  الى  50  يوم بشكل  افقي  

 

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

 

لانني ارغب  بان احصل على متوسط  ايام  لمدة 50  يوم  لكل عمود  من اعمدة  اللون الاخضر 

 

 

شكرا مقدما احبتنا الافاضل

 

الملف مرفق

 

==========

 

نعتذر  لتكرار المشاركة الاخيرة  عدة مرات 

اكسل التجااااااارب.rar

[ا بو سليمان]

لا زلت انتظر ابداعك اخي الفاضل

[شوقي ربيع]

جرب هذا

اكسل التجااااااارب.rar

[ا بو سليمان]

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

 

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

 

ولكن  يعلم الله ان هذا الموضوع  مهم جدا جدا لي  ولهذا  فانني  اعتذر  منك  لايضاح طلبي  الاخير  ........

 

وهو  ان صفحة الاكسل الاساسيه تبقى على حالها 

 

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

 

يعني ( اقل سعر  في صفحة لوحدة   و  الاعلي في صفحة لوحدة   و الا دني في صفحة لوحدة  و اغلاق سابق في صفحة لوحدة  و الحجم في صفحة لوحدة  و الفتح في صفحة لوحدة

 

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

 

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

 

 

اكرر بااااااااااااالغ اسفي   واكرر بااااااااالغ امتناني  لك  وللموقع الكريم

 

هذا هو المطلوب في الملف ولكن يبدولي انني لم اوضح بالشكل المطلوب  على اعبار انني  اوصلت المعلومه  فاكرر اعتذاري  لشخصكم الكريم

[شوقي ربيع]

السلام عليكم

غدا ان شاء الله تجد الملف المعدل كما طلبت

[ا بو سليمان]

بانتظااااااااااااااااار ابداعكم 

[شوقي ربيع]

السلام عليكم

تفضل اخي

 

ملاحضة الكود بطيىء شوي انتضره لحظات قليلة فقط ليقوم بلازم

 

اكسل التجااارب.rar

[ا بو سليمان]

احسن الله اليك اخي شوقي على  مجهوووووودك الرائع   سوف اتصفح الملف 

شكرا لك  

[ا بو سليمان]

اخي شوقي  اعرف انك بذلت جهد كبير  في مساعدتي  ........ وانا في غايه الامتنان لك 

 

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

[شوقي ربيع]

السلام عليكم

لم افهم قصدك بلا يحدث الاعمدة المطلوبة

[ا بو سليمان]

السلام عليكم

لم افهم قصدك بلا يحدث الاعمدة المطلوبة

السلام عليكم اخي  شوقي  وسدد على طريق الخير خطاكم   ورحفظكم من كل سوء  

 

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

 

مثال 

العمود الاول  قيمة السبت 10  

 

مفترض الاحد  تنتقل القمية 10 الى عمود الثاني  وهكاذا  .......  مع عدم التاثر في تغير قيمة العمود الاول  عندما تتغير من قيمة 10 الى قيمة  20 مثلا  

تم تعديل أغسطس 11, 2013 بواسطه zmzm