كود للترقيم التلقائي

[ناصر سعيد]

بسم الله الرحمن الرحيم

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

نريد كودا للترقيم التلقائي في اكسيل

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

[حسام نور]

الكود

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    If Target.Value <> "" Then
      With Cells(Target.Row, Target.Column - 1)
        .FormulaR1C1 = _
          "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R2C[1]:RC[1]),"""")"
      End With
    Else
      Cells(Target.Row, Target.Column - 1).ClearContents
    End If
  End If
End Sub

وفي المرفقات مثال

____________.zip

[ناصر سعيد]

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

شكرا للاستاذ حسام

انار الله له طريق الخير إن شاء الله

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

ماذا نفعل مع الكود حتى يتلاءم مع احتياجات كل واحد ؟

ولك الشكر

[ابو اسامة العينبوسي]

السلام عليكم

لا شك ان ردى على مشاركه للاستاذ حسام نور يعتبر تعدى كبير

لكن منه نتعلم

اخوك (عمر)ابو اسامه

count.rar

[super hero]

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

تم تعديل أكتوبر 1, 2007 بواسطه super hero

[islam11]

ولكن ياأخوة نريد ان نعرف كيف نغير في الكودين الرائعين لكى نغير خلية البداية

سواء كان اسم او الرقم المقابل له

مثلا اريد ان اكتب الاسم في عمود h الصف السابع ماذا افعل ؟

كيفية التغيير يا أخي بصفة عامة اشرحوها لنا ؟

ولكم الشكر

تم تعديل أكتوبر 1, 2007 بواسطه islam11

[محمدي عبد السميع]

للرفع

الاستاذ حسام نور

انت عملاق من عمالقة المنتدى وكثير من المنتديات

فنرجو ان تظل في هذا المنتدى بمشاركاتك الايجابية

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

من حيث تعديل خلية بداية كتابة الاسماء

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

تم تعديل أكتوبر 2, 2007 بواسطه mohammadey1

[علي فاهم]

للرفع

[حسام نور]

أعتذر لتغيبي الفترة السابقة

سأعود لتوضيح أستفساراتكم لاحقاً ... وشكراً

[ناصر سعيد]

أعتذر لتغيبي الفترة السابقة

سأعود لتوضيح أستفساراتكم لاحقاً ... وشكراً

كده الكلام

الله يبارك لك

[حسام نور]

أولاً .. هذا هو الكود كاملاً

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    If Target.Value <> "" Then
      With Cells(Target.Row, Target.Column - 1)
        .FormulaR1C1 = _
          "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R2C[1]:RC[1]),"""")"
      End With
    Else
      Cells(Target.Row, Target.Column - 1).ClearContents
    End If
  End If
End Sub

لاحظ في السطر الثاني من الكود

 If Target.Column = 2 Then

هذا هو رقم العمود الذي سنقوم بالكتابة به وهو هنا رقم ( 2 ) أي العمود ( B ) ويمكننا تغييره حسب الرغبه . وسيتم الترقيم في العمود المجاور له لاحظ في السطر التالي في الكود

   "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R[color="#FF0000"]2[/color]C[1]:RC[1]),"""")"

الرقم ( 2 ) الملون بالأحمر هو رقم الصف الذي سيبدأ الترقيم منه . ويمكن تغييره حسب الرغبه

[ناصر سعيد]

شكرا شكرا

نرجو ارفاق

ملف وبه سهم يشير على رقم الصف ورقم العمود المراد تغييره

ولك شكرنا وتحياتنا

[علي فاهم]

أولاً .. هذا هو الكود كاملاً

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    If Target.Value <> "" Then
      With Cells(Target.Row, Target.Column - 1)
        .FormulaR1C1 = _
          "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R2C[1]:RC[1]),"""")"
      End With
    Else
      Cells(Target.Row, Target.Column - 1).ClearContents
    End If
  End If
End Sub

لاحظ في السطر الثاني من الكود

 If Target.Column = 2 Then

هذا هو رقم العمود الذي سنقوم بالكتابة به وهو هنا رقم ( 2 ) أي العمود ( B ) ويمكننا تغييره حسب الرغبه . وسيتم الترقيم في العمود المجاور له لاحظ في السطر التالي في الكود

   "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R[color="#FF0000"]2[/color]C[1]:RC[1]),"""")"

الرقم ( 2 ) الملون بالأحمر هو رقم الصف الذي سيبدأ الترقيم منه . ويمكن تغييره حسب الرغبه

اين اللون الاحمر

السطر التالي الذي ذكرته لتغيير رقم الصف لاوجود له في الكود الكامل

ارفق ملف

وشكرا

تم تعديل أكتوبر 11, 2007 بواسطه alyfahem

[ابو اسامة العينبوسي]

السلام عليكم

color="#FF0000"]

هذا هو كود اللون

تم تعديل أكتوبر 11, 2007 بواسطه ابو اسامة العينبوسي

[ناصر سعيد]

شكرا اخي ابو اسامه

ولكن اين الرقم 2 المطلوب لتغيير الصف

[ابو اسامة العينبوسي]

R2C

[ناصر سعيد]

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

[حسام نور]

أولاً .. هذا هو الكود كاملاً

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    If Target.Value <> "" Then
      With Cells(Target.Row, Target.Column - 1)
        .FormulaR1C1 = _
          "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R2C[1]:RC[1]),"""")"
      End With
    Else
      Cells(Target.Row, Target.Column - 1).ClearContents
    End If
  End If
End Sub

لاحظ في هذا السطر الثاني من الكود

 If Target.Column = [color="#FF0000"]2[/color] Then

هذا هو رقم العمود الذي سنقوم بالكتابة به وهو هنا رقم ( 2 ) أي العمود ( B ) ويمكننا تغييره حسب الرغبه . وسيتم الترقيم في العمود المجاور له لاحظ في السطر التالي في الكود

   "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R[color="#FF0000"][color="#FF0000"]2[/color][/color]C[1]:RC[1]),"""")"

الرقم ( 2 ) الملون هو رقم الصف الذي سيبدأ الترقيم منه . ويمكن تغييره حسب الرغبه

حاولت تلوين الرقم عبر المنتدى ولكن لم انجخ عموما ... السطر الثاني من الكود ستجد به رقم ( 2 ) هذا هو رقم العمود الذي ستقوم بالكتابه به ليظهر في العمود الذي بجواره الترقيم لاحظ في السطر التالي في الكود

   "=IF(COUNTA(RC[1]:RC[1])=1,COUNTA(R[color="#FF0000"][color="#FF0000"]2[/color][/color]C[1]:RC[1]),"""")"

الرقم ( 2 ) هو رقم الصف الذي سيبدأ الترقيم منه . ويمكن تغييره حسب الرغبه

تم تعديل أكتوبر 14, 2007 بواسطه حسام نور

[ناصر سعيد]

شكرا لردك اخي حسام

وكل عام وانت طيب

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

ولك الشكر

[ابو اسامة العينبوسي]

السلام عليكم

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

يعجبنى الحاحك

____________.rar

[ناصر سعيد]

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

الكود به الرقم 8 وهو لتغيير العمود والرقم 6 وهو لتغيير الصف ... شكرا

ولكن الرقم 5 اوجدته مافائدته

حتى يتم فهمها صح

[ابو اسامة العينبوسي]

الكود يعمل عندما يكون العمود المفعل رقم 8 و السطر المفعل >5 اي اكبر من خمسه

يعنى 6 .7 8. 9.10 الخ