Note: The other languages of the website are Google-translated. Back to English

كيفية نقل الصف بأكمله إلى أسفل الورقة النشطة بناءً على قيمة الخلية في إكسيل؟

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

انقل الصف بأكمله إلى أسفل الورقة النشطة بناءً على قيمة الخلية برمز VBA


انقل الصف بأكمله إلى أسفل الورقة النشطة بناءً على قيمة الخلية برمز VBA

على سبيل المثال ، كما هو موضح أدناه ، إذا كانت إحدى الخلايا الموجودة في العمود C تحتوي على قيمة معينة "تم" ، فانقل الصف بأكمله إلى أسفل الورقة الحالية. الرجاء القيام بما يلي.

1. صحافة قديم+ F11 مفاتيح في نفس الوقت لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. في ال ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق إدراج > وحدة. ثم انسخ والصق رمز فبا أدناه في النافذة.

كود فبا: انقل الصف بأكمله إلى أسفل الورقة النشطة بناءً على قيمة الخلية

Sub MoveToEnd()
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Application.InputBox("Select range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

ملاحظة: في رمز VBA ، "تم. "هي قيمة الخلية التي ستنقل الصف بأكمله بناءً عليها. يمكنك تغييره كما تريد.

3. اضغط على F5 مفتاح لتشغيل التعليمات البرمجية ، ثم في ظهرت كوتولس ل إكسيل في مربع الحوار ، حدد نطاق العمود الذي توجد فيه قيمة معينة ، ثم انقر فوق OK .

بعد النقر على OK ، يتم نقل الصف بأكمله الذي يحتوي على القيمة "تم" في العمود المحدد إلى أسفل نطاق البيانات تلقائيًا.


مقالات ذات صلة:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (28)
تقييم شنومك من شنومكس · تصنيفات 2
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني عمل ذلك بحيث يختار kutools صفوفًا معينة دون إدخال المستخدم؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا انون
أنا آسف ، لست متأكدًا مما تقصده. سيكون لطيفًا إذا كان بإمكانك شرحه مرة أخرى أو تقديم لقطة شاشة لإظهار ما تحاول القيام به.
شكرا لتعليقك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كريستال ، هذا الرمز يعمل بشكل رائع ، شكرًا لك. أرغب في نقل جميع الصفوف التي تحتوي على كلمة "كاملة" في العمود D إلى أعلى الجدول (تدرج في الصف 3). هل هذا ممكن؟ ثم أود حذف كل هذه الصفوف الكاملة التي تحتوي على "تاريخ الأمس" في العمود V.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا. هذا يكاد يكون مثاليا لما أريد. لدي جزء من نفس الطلب حيث كان على Anon إجراء هذا العمل دون إدخال المستخدم مع بعض الإضافات.

أتساءل عما إذا كان من الممكن البحث عن العمود الوحيد ليكون من i4 إلى i50 وتشغيله تلقائيًا عند الفتح أو في أي وقت يتم فيه تحرير العمود i. أيضًا إذا كان من الممكن نقل الصفوف إلى أسفل الورقة بدون أي صفوف فارغة بين الصفوف "المنجزة" والصفوف "لا". حاليًا إذا حددت i4: i50 وإذا كان لدي بيانات حتى الصف 25 فقط ، فسيتم لصق الصفوف "تم" تصاعديًا من الصف 50 بدلاً من الصف 25. يتغير عدد الصفوف في صفحتي باستمرار ولا ينبغي أن تصل إلى أكثر من 50. شكرا للمساعدة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا براندون ،
آسف يمكن أن تساعدك في ذلك. شكرا لك على تعليقك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هل هناك طريقة لتعديل هذا بحيث يتحرك صفًا في مكان آخر في نفس الورقة بجانب النهاية؟ لدي ورقة بها معلومات عن الطلبات المؤرخة والأوامر القادمة التي لم يتم تأريخها بعد ولديها لذلك عندما أضع علامة "X" في العمود A ، قم بتمييز الأشياء وجريئها اعتمادًا على الجزء # ومواقع الشحن. الآن يجب أن أقوم ماديًا بقص ولصق (تاريخ الشحن) الذي تم تأريخه حديثًا بحيث يتلاءم مع الجزء العلوي المصنف حسب التاريخ (من الأول إلى نهاية الشهر). لقد تمكنت من التنسيق الشرطي لكل شيء حتى هذه النقطة ، لكن لا أعتقد أنه يمكنني تحريك الصفوف بهذه الطريقة. كنت أتساءل عما إذا كان VBA يمكنه القيام بذلك ، أو نقل صف عند إدخال تاريخ يتناسب مع الصفوف المؤرخة الأخرى؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، الطريقة الوحيدة التي يمكنني من خلالها تشغيل هذا هو إذا قمت "بتشغيل" الماكرو في الشاشة الفرعية لـ Visual Basic. هل من الممكن تشغيل رمز VBA تلقائيًا ، بمجرد قيام المستخدم بكتابة كلمة "تم"؟ في كل مرة أحصل على مربع حوار Kutools for Excel المنبثق لأطلب من المعلمات التي أطلب الرمز للبحث عنها. لقد عملت نوعًا ما حول هذا عن طريق استبدال: xTxt = ActiveSheet.UsedRange.AddressLocal بالمعلمات التي أريد البحث عنها وضرب إدخال. ولكن سيكون من الأسهل إجراء التغييرات تلقائيًا بعد إدخال "تم". شكرًا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا انون
يمكن أن يقدم لك رمز VBA أدناه معروفًا. يرجى المحاولة.
يرجى النقر بزر الماوس الأيمن فوق علامة تبويب الورقة (تحتوي الورقة على البيانات التي ستنقلها إلى الأسفل) ، وحدد عرض الرمز من قائمة السياق وانسخ الكود أدناه في نافذة الكود.

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
'تم التحديث بواسطة Extendoffice 20190925
خافت xRg كمدى
خافت xIRg كمجموعة
خافت xTxt كسلسلة
خافت xCell كمجموعة
خافت xEndRow بالطول
أنا خافت وطويلة
خافت xDStr كسلسلة
على خطأ استئناف التالي
xDStr = "C: C"
تعيين xRg = Me.Range (xDStr)
تعيين xIRg = Application.Intersect (الهدف ، xRg)
إذا كان xIRg لا شيء ، فاخرج من Sub
Application.ScreenUpdating = خطأ
Application.EnableEvents = خطأ

إذا كان الهدف = "تم" ثم
xEndRow = ActiveSheet.UsedRange.Rows.Count + 1
الهدف. الصف بأكمله
الصفوف (xEndRow). أدخل التحول: = xlDown
إنهاء حالة
Application.EnableEvents = صحيح
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

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

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)

'تم التحديث بواسطة Extendoffice 20200424

خافت xRg كمدى

خافت xIRg كمجموعة

خافت xTxt كسلسلة

خافت xCell كمجموعة

خافت xEndRow بالطول

أنا خافت وطويلة

خافت xDStr كسلسلة

انتقل إلى الخطأ Err1

xDStr = "C: C"

تعيين xRg = Me.Range (xDStr)

تعيين xIRg = Application.Intersect (الهدف ، xRg)

إذا كان xIRg لا شيء ، فاخرج من Sub

Application.ScreenUpdating = خطأ

Application.EnableEvents = خطأ



إذا كانت Target.Value = "تم" ثم

'xEndRow = ActiveSheet.UsedRange.Rows.Count + 1

xEndRow = ActiveSheet.UsedRange.SpecialCells (xlCellTypeLastCell) .Row + 1

الهدف. الصف بأكمله

الصفوف (xEndRow). أدخل التحول: = xlDown

إنهاء حالة

Err1:

Application.EnableEvents = صحيح

Application.ScreenUpdating = ترو

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
حاولت نسخ هذا الرمز لكنه لا يزال يقول استخدام غير صالح لي.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ماذا لو كنت تحتاج فقط إلى نقل الصفوف الموجودة أسفل العمود "أ" و "ب" ؛ ثم يجب أن يحتفظ العمود C؟ هل يجب علينا الاستمرار في استخدام EntireRow؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جيرل ،
جرب الكود أدناه. آمل أن أتمكن من المساعدة.

Sub MoveToEnd ()

'تم التحديث بواسطة Extendoffice 20200717

خافت xRg كمدى

خافت xTxt كسلسلة

خافت xCell كمجموعة

خافت xEndRow بالطول

خافت xIntR كعدد صحيح

أنا خافت وطويلة

خافت xWs كورقة عمل

على خطأ استئناف التالي

إذا كان ActiveWindow.RangeSelection.Count> 1 ثم

xTxt = ActiveWindow.RangeSelection.AddressLocal

آخر

xTxt = ActiveSheet.UsedRange.AddressLocal

إنهاء حالة

واحد:

تعيين xRg = Application.InputBox ("حدد النطاق:" ، "Kutools for Excel" ، xTxt ، ، ، ، ، ، 8)

إذا كان xRg لا شيء ، فاخرج من Sub

إذا كانت xRg.Columns.Count> 1 أو xRg.Areas.Count> 1 ثم

MsgBox "تم تحديد نطاقات أو أعمدة متعددة" ، vbInformation ، "Kutools for Excel"

اذهب إلى لون واحد

إنهاء حالة

xEndRow = xRg.Rows.Count + xRg.Row

xWs = xRg. ورقة العمل

xWs.Activate

Application.ScreenUpdating = خطأ

بالنسبة إلى I = xRg.Rows.Count To 1 Step -1

إذا كان xRg.Item (I) = "تم" ثم

الصفوف (xEndRow). أدخل التحول: = xlDown ، CopyOrigin: = xlFormatFromLeftOrAbove

xIntR = xRg.Cells (I) .Row

النطاق ("A" & xIntR & ": B" & xIntR). حدد

التحديد

النطاق ("A" & xEndRow). حدد

ActiveSheet.Paste

xEndRow = xEndRow + 1



إنهاء حالة

التالى

Application.ScreenUpdating = ترو

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،



أواجه مشكلات في استخدام الشفرة المقدمة وأتلقى باستمرار خطأ في بناء الجملة. أنا جديد تمامًا على التفوق وكنت أحاول تعليم نفسي ما أحتاجه لإدارة عملي المنزلي. لدي معرّف جدول بيانات مخزون ترغب في أن أتمكن من تعيين عناصر في عمود كـ RETIRED؟ نعم / لا ، وإذا كانت الإجابة بنعم ، فإنهم ينتقلون إلى أسفل الورقة ، بترتيب أبجدي ، دون ترك مسافة فارغة في ورقة الانتشار الرئيسية. لدينا عناصر متوقفة تمامًا ثم نعود لإعادة إصدار خاص بكميات محدودة ومعرف مثل هذه العناصر المخزنة في أسفل الورقة الخاصة بي حتى تصبح متاحة مرة أخرى. شكرًا لك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لدي مهمة كلفني بها مديري. بدا الأمر بسيطًا بما يكفي في البداية ولكني الآن في حيرة من أمري فيما يتعلق بكيفية المضي قدمًا. لدينا ورقة توقع للوظائف المحتملة ولديها عمود "احتمالية الطلب" بنسبة٪. يريدني أن أقوم بإعداد 3 أوراق مختلفة بنسبة 100-70٪ و 69٪ -41 و 40-0٪. الفكرة هي أنه عندما يتم كتابة المعلومات في الورقة الرئيسية ، عند إدخال النسبة المئوية ، يتم نسخها تلقائيًا في ورقة المتابعة التي تتطابق مع هذا المعدل المئوي. لقد فعلت ذلك باستخدام IF (وصيغة. ومع ذلك ، أحتاج إلى الفرز بالترتيب لتفقد الخلايا الفارغة وجعلها تبدو أكثر نظافة. ثم عندما أقوم بالفرز ، إذا أضفت عرضًا جديدًا لاحتمالية Oder إلى الورقة الرئيسية ، فلن يتم ذلك تلقائيًا أظهرها ، دون إلغاء الترتيب ثم الترتيب مرة أخرى. أعتذر إذا كان هذا السؤال لا يخصها. ولكن هل هناك سلسلة من التعليمات البرمجية التي يمكنني وضعها للتعامل مع هذه المشكلة بشكل أسهل؟ القيمة الوحيدة التي تحدد ما إذا تم نقل الصف بالكامل هي يبدو العمود K بسيطًا ولكنه معقد لهذا المبتدئ المتميز. شكرًا مقدمًا على مساعدتك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يتم ذلك إذا كانت كلمة "Done" مجرد جزء من سلسلة عمود. لنفترض أن أعمدتي تحتوي على قيمة مثل - XYZDone و ABCDone و 123 Done وما إلى ذلك ، هل يمكنني التصفية استنادًا إلى السلسلة الجزئية "تم"؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،
شكرًا لك على المساعدة ، تعمل الشفرة بشكل رائع ولكن بدلاً من نقل الصف إلى أسفل الصفحة ، كيف أقوم بنقله إلى علامة تبويب أخرى ، مثل علامة التبويب "مغلقة"؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
آسف للرد في وقت متأخر جدا.
في الكود ، ما عليك سوى تغيير الخط "إذا كانت xRg.Cells (I) = "تم" ثم" إلى إذا كانت xRg.Cells (I) Like "* Done *" ، فحينئذٍ لإنجازها.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي قائمة بها خانات اختيار أنه عند تحديد عمود واحد ، أحتاجه للانتقال إلى قسم واحد من جدول البيانات وإذا تم تحديد الآخر بدلاً من ذلك ، فإنه ينتقل إلى النهاية. لقد جربت مئات الطرق المختلفة للقيام بذلك ، هل يمكن لأي شخص المساعدة في ذلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أهلاً! لقد اشتريت للتو kutools حتى أتمكن من *** رمز vba هذا على ورقة Excel الخاصة بي ، حيث ستكون ميزة ممتازة للاستخدام! التعليمات أعلاه بسيطة ومفيدة ؛ ومع ذلك ، بمجرد وصولي إلى الخطوة حيث يتم نسخ الرمز ولصقه في النافذة والضغط على F5 ، أرسلني إلى مربع لتسمية وإنشاء الماكرو. لقد فعلت ذلك ولكن الآن لن يأخذني إلى مربع الحوار حتى أتمكن من تحديد نطاق الخلايا. يظهر خطأ تجميع لـ "إجراء خارجي غير صالح". الرجاء المساعدة!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
أنا آسف لتضليلك. يمكن استخدام الكود من تلقاء نفسه ولا يتطلب شراء Kutools. إذا لم تكن بحاجة إليها ، فيرجى إرسال بريد إلكتروني إلى sales @extendoffice.com لطلب استرداد.
لكي يعمل الرمز بسلاسة ، يجب التأكد من وجود المؤشر في نافذة الكود (انقر فوق أي كلمة في الكود) ، ثم اضغط على F5 مفتاح لتشغيل الكود. ثم سيظهر مربع الحوار لتحديد نطاق الخلية.
آسف مرة أخرى على الإزعاج.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أنا مرة أخرى! لقد اكتشفت الكود. لقد قمت بنسخ الكود ولصقه يدويًا بدلاً من استخدام زر النسخ في أعلى يمين الشاشة. لقد غيرت "فعلت" إلى "س". لقد قمت بتشغيل الكود في كل ورقة عمل. عندما أبدأ بإدخال "x" في تلك الخلايا داخل نطاقات الخلايا المحددة من مربع الحوار ، لا يحدث شيء (لا تتحرك الصفوف تلقائيًا لأسفل إلى الأسفل). أنا جديد جدًا على هذا .... شكرًا على مساعدتك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
إذا كنت تريد نقل الصف إلى أسفل تلقائيًا عند إدخال الكلمة المحددة ، فيرجى تجربة رمز VBA التالي.
ملاحظة: تحتاج إلى إدخال الرمز في نافذة رمز ورقة العمل (انقر بزر الماوس الأيمن فوق علامة تبويب الورقة وحدد عرض الرمز من قائمة السياق).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20220520
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Range("C2:C18")
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

شكرا لك على كل الرموز الرائعة. هل هناك طريقة للقيام بذلك بدون Kutools؟ لا أرى أيضًا مربع حوار لتحديد نطاق خلايا ، فهو لا يظهر لي.

شكرا لكم,
الجاز
تقييم شنومك من شنومكس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جاز ،
يمكنك تحديد نطاق الخلايا مباشرة في الكود دون الحاجة إلى إظهار مربع حوار Kutools لتحديد النطاق.
في الكود ، يرجى استبدال السطر التالي:
Set xRg = Application.InputBox("Select range:", "Kutools for Excel", xTxt, , , , , 8)

مع:
Set xRg = Range("C2:C13")
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل هناك طريقة لإعادة الصفوف إلى المكان الأصلي عندما تتغير حالة الإدخال؟ على سبيل المثال ، إذا قام شخص ما بتغييره من "تم" إلى "غير مكتمل" ، فهل هناك طريقة لبرمجة برنامج Excel لإعادته مرة أخرى؟
أيضا ، هل هذا التغيير دائم؟ لاحظت بعد العمل في المرة الأولى أنه توقف عن العمل بعد ذلك.

شكرا لك على مساعدتك ونشر!
تقييم شنومك من شنومكس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا زوي ،

شكرا لتعليقك.
1. للسؤال الأول:
لا يمكن إرجاع الصف الذي تم نقله إلى مكانه الأصلي ؛
2. للسؤال الثاني:
يجب تشغيل رمز VBA يدويًا في كل مرة تحتاج فيها إلى نقل الصفوف. إذا كنت تريد نقل الصف تلقائيًا عندما تتطابق قيمة الخلية مع الشرط ، يمكنك تجربة التعليمات البرمجية لـ VBA التالية.
ملاحظة: تحتاج إلى وضع هذا الرمز في محرر الورقة (الرمز) (انقر بزر الماوس الأيمن فوق علامة تبويب الورقة وحدد عرض الرمز لفتح المحرر). وقم بتغيير نطاق العمود B2: B12 إلى النطاق الخاص بك.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated Extendoffice 20230111
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xEndRow As Long
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
lOne:
    Set xRg = Range("B2:B12")
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Or xRg.Areas.Count > 1 Then
        MsgBox " Multiple ranges or columns have been selected ", vbInformation, "Kutools for Excel"
        GoTo lOne
    End If
    xEndRow = xRg.Rows.Count + xRg.Row
    Application.ScreenUpdating = False
    For I = xRg.Rows.Count To 1 Step -1
        If xRg.Cells(I) = "Done" Then
           xRg.Cells(I).EntireRow.Cut
           Rows(xEndRow).Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True

End Sub
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL