كيفية نقل العناصر بسرعة بين مربعي القائمة في إكسيل؟
هل سبق لك أن حاولت نقل العناصر من مربع قائمة إلى مربعات قائمة أخرى كما تحتاج كما هو موضح أدناه؟ هنا سأتحدث عن هذه العملية في Excel.
نقل العناصر بين مربعات القوائم
نقل العناصر بين مربعات القوائم
لا توجد وظيفة مضمنة يمكن أن تساعدك في إنهاء المهمة ، ولكن لدي رمز VBA يمكنه تقديم خدمة.
1. أولاً ، تحتاج إلى إنشاء قائمة بالبيانات التي ستظهر كعناصر في مربعات القائمة في ورقة جديدة تسمى قوائم_الإدارة.
2. ثم حدد هذه البيانات وانتقل إلى الاسم مربع لمنحهم اسم قائمة البند. انظر لقطة الشاشة:
3. ثم في الورقة التي تحتوي على مربعي القائمة ، انقر فوق المطور > إدراج > مربع القائمة (عنصر تحكم نشط X)، وارسم مربعي قائمة. انظر لقطة الشاشة:
إذا كان المطور علامة التبويب مخفية الشريط الخاص بك ، كيفية إظهار / عرض علامة تبويب المطور في شريط Excel 2007/2010/2013؟ ستخبرك هذه المقالة بكيفية إظهارها.
4. ثم اضغط المطور > إدراج > زر الأمر (التحكم النشط X)، وارسم أربعة أزرار بين مربعي قائمة. انظر لقطة الشاشة:
الآن لإعادة تسمية أزرار الأوامر الأربعة بأسماء جديدة.
5. حدد زر الأمر الأول ، انقر فوق عقارات، وفي عقارات جزء ، أعط اسما BTN_moveAllRight إليها ، واكتب >> في مربع النص بجانب شرح. انظر لقطة الشاشة:
6. كرر الخطوة 5 لإعادة تسمية الأزرار الثلاثة الأخيرة بالأسماء أدناه ، واكتب أيضًا السهم المختلف في التسميات التوضيحية. انظر لقطة الشاشة:
BTN_MoveSelected يمينًا
BTN_moveAll اليسار
BTN_MoveSelectedLeft
7. انقر بزر الماوس الأيمن فوق اسم الورقة الذي يحتوي على مربعات القوائم وأزرار الأوامر ، ثم حدد عرض الرمز من قائمة السياق. انظر لقطة الشاشة:
8. انسخ والصق رمز الماكرو أدناه إلى ملف وحدة النصي ثم احفظ الكود وأغلق ملف ميكروسوفت فيسوال باسيك للتطبيقات نافذة او شباك. انظر لقطة الشاشة
فبا: نقل العناصر بين مربعي قائمة
Private Sub Worksheet_Activate()
'UpdatebyExtendoffice20171117
Dim xCell As Range
Dim xRg As Range
Set xRg = Sheets("Admin_Lists").Range("ItemList")
Me.ListBox1.Clear
Me.ListBox2.Clear
With Me.ListBox1
.LinkedCell = ""
.ListFillRange = ""
For Each xCell In xRg
If xCell <> "" Then
.AddItem xCell.Value
End If
Next xCell
End With
Me.ListBox1.MultiSelect = fmMultiSelectMulti
Me.ListBox2.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub BTN_MoveSelectedLeft_Click()
Call moveSigle(Me.ListBox2, Me.ListBox1)
End Sub
Private Sub BTN_MoveSelectedRight_Click()
Call moveSigle(Me.ListBox1, Me.ListBox2)
End Sub
Private Sub BTN_moveAllLeft_Click()
Call moveAll(Me.ListBox2, Me.ListBox1)
End Sub
Private Sub BTN_moveAllRight_Click()
Call moveAll(Me.ListBox1, Me.ListBox2)
End Sub
Sub moveAll(xListBox1 As Object, xListBox2 As Object)
Dim I As Long
For I = 0 To xListBox1.ListCount - 1
xListBox2.AddItem xListBox1.List(I)
Next I
xListBox1.Clear
End Sub
Sub moveSigle(xListBox1 As Object, xListBox2 As Object)
Dim I As Long
For I = 0 To xListBox1.ListCount - 1
If I = xListBox1.ListCount Then Exit Sub
If xListBox1.Selected(I) = True Then
xListBox2.AddItem xListBox1.List(I)
xListBox1.RemoveItem I
I = I - 1
End If
Next
End Sub
9. ثم انتقل إلى ورقة أخرى ثم ارجع إلى الورقة التي تحتوي على مربعات القائمة ، والآن يمكنك رؤية قائمة بيانات القائمة في مربع القائمة الأول. وانقر فوق أزرار الأوامر لنقل العناصر بين مربعي القائمة.
نقل التحديد
حرك الكل
أفضل أدوات إنتاجية المكتب
عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت. انقر هنا للحصول على الميزة التي تحتاجها أكثر...
يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير
- تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
- فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
- يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!