انتقل إلى المحتوى الرئيسي

نصائح Excel: قم بتقسيم البيانات إلى أوراق عمل/مصنفات متعددة بناءً على قيمة العمود

المؤلف: شياويانغ آخر تعديل: 2024-04-26

عند إدارة مجموعات بيانات كبيرة في Excel، قد يكون من المفيد للغاية تقسيم البيانات إلى أوراق عمل متعددة بناءً على قيم أعمدة محددة. لا تعمل هذه الطريقة على تحسين تنظيم البيانات فحسب، بل تعمل أيضًا على تحسين إمكانية القراءة وتسهيل تحليل البيانات بشكل أسهل.

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

تقسيم البيانات إلى أوراق عمل متعددة بناءً على قيمة العمود

قم بتقسيم البيانات إلى مصنفات متعددة بناءً على قيمة العمود باستخدام كود VBA


تقسيم البيانات إلى أوراق عمل متعددة بناءً على قيمة العمود

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

قم بتقسيم البيانات إلى أوراق عمل متعددة بناءً على قيمة العمود باستخدام رمز VBA

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

2. انقر إدراج > وحدة، والصق التعليمة البرمجية التالية في نافذة الوحدة النمطية.

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

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

4. في مربع المطالبة الثاني، يرجى تحديد بيانات العمود التي تريد تقسيمها بناءً عليها، ثم انقر فوق OK. انظر لقطة الشاشة:

5. يتم تقسيم جميع البيانات الموجودة في ورقة العمل النشطة إلى أوراق عمل متعددة بناءً على قيم الأعمدة. تتم تسمية أوراق العمل الناتجة وفقًا للقيم الموجودة في الخلايا المقسمة ويتم وضعها في نهاية المصنف. انظر لقطة الشاشة:

 

قم بتقسيم البيانات إلى أوراق عمل متعددة بناءً على قيمة العمود باستخدام Kutools for Excel

كوتولس ل إكسيل يجلب ميزة ذكية - تقسيم البيانات مباشرة في بيئة Excel الخاصة بك. لم يعد تقسيم البيانات إلى أوراق عمل متعددة يمثل تحديًا. تقوم أداتنا البديهية بتقسيم مجموعة البيانات الخاصة بك تلقائيًا بناءً على قيمة العمود المحدد أو عدد الصفوف، مما يضمن أن كل جزء من المعلومات موجود بالضبط في المكان الذي تحتاج إليه. قل وداعًا للمهمة الشاقة المتمثلة في تنظيم جداول البيانات يدويًا واعتمد طريقة أسرع وخالية من الأخطاء لإدارة بياناتك.

ملاحظات: لتطبيق هذا تقسيم البياناتأولاً ، يجب عليك تنزيل ملف كوتولس ل إكسيل، ثم قم بتطبيق الميزة بسرعة وسهولة.

بعد تثبيت كوتولس ل إكسيل، وحدد نطاق البيانات، ثم انقر فوق كوتولس بلس > تقسيم البيانات لفتح تقسيم البيانات إلى أوراق عمل متعددة صندوق المحادثة.

  1. أختار عمود محدد الخيار في انقسام على أساس القسم، واختر قيمة العمود الذي تريد تقسيم البيانات بناءً عليه من القائمة المنسدلة.
  2. إذا كانت بياناتك تحتوي على رؤوس وتريد إدراجها في كل ورقة عمل مقسمة جديدة، فيرجى التحقق من ذلك بياناتي لها رؤوس خيار. (يمكنك تحديد عدد صفوف الرؤوس بناءً على بياناتك. على سبيل المثال، إذا كانت بياناتك تحتوي على رأسين، فيرجى كتابة 2.)
  3. ثم يمكنك تحديد أسماء أوراق العمل المنقسمة ، ضمن ملف اسم أوراق العمل الجديدة القسم، حدد قاعدة أسماء أوراق العمل من القائمة المنسدلة "القواعد"، ويمكنك إضافة بادئة or لاحقة لأسماء الأوراق أيضًا.
  4. انقر على OK زر. انظر لقطة الشاشة:

الآن، يتم تقسيم البيانات الموجودة في ورقة العمل إلى أوراق عمل متعددة في مصنف جديد.


قم بتقسيم البيانات إلى مصنفات متعددة بناءً على قيمة العمود باستخدام كود VBA

في بعض الأحيان، بدلاً من تقسيم البيانات إلى أوراق عمل متعددة، قد يكون من المفيد تقسيم البيانات إلى مصنفات منفصلة بناءً على عمود رئيسي. فيما يلي دليل خطوة بخطوة حول كيفية استخدام التعليمات البرمجية لـ VBA لأتمتة عملية تقسيم البيانات إلى مصنفات متعددة بناءً على قيمة عمود محددة.

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

2. انقر إدراج > وحدة، والصق الكود التالي في ملف نافذة الوحدة.

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", Type:=8)
    If TypeName(xTRg) = "Nothing" Then Exit Sub
    Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", Type:=8)
    If TypeName(xVRg) = "Nothing" Then Exit Sub
    vcol = xVRg.Column
    Set ws = xTRg.Worksheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = xTRg.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub
ملاحظات: في الكود أعلاه، يجب عليك تغيير مسار الملف إلى المسار الخاص بك حيث سيتم حفظ المصنفات المقسمة في هذا البرنامج النصي: savePath = "C:\Users\AddinsVM001\Desktop\multiple files\".

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

4. في مربع المطالبة الثاني، يرجى تحديد بيانات العمود التي تريد تقسيمها بناءً عليها، ثم انقر فوق OK. انظر لقطة الشاشة:

5. بعد التقسيم، يتم تقسيم جميع البيانات الموجودة في ورقة العمل النشطة إلى مصنفات متعددة بناءً على قيم الأعمدة. يتم حفظ كافة المصنفات المقسمة في المجلد الذي حددته. انظر لقطة الشاشة:

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

  • تقسيم البيانات إلى أوراق عمل متعددة حسب عدد الصفوف
  • يمكن أن يؤدي تقسيم نطاق بيانات كبير بكفاءة إلى أوراق عمل Excel متعددة بناءً على عدد صفوف محدد إلى تبسيط إدارة البيانات. على سبيل المثال، يمكن أن يؤدي تقسيم مجموعة البيانات كل 5 صفوف إلى أوراق متعددة إلى جعلها أكثر قابلية للإدارة والتنظيم. يقدم هذا الدليل طريقتين عمليتين لإنجاز هذه المهمة بسرعة وسهولة.
  • دمج جدولين أو أكثر في جدول واحد بناءً على الأعمدة الرئيسية
  • لنفترض أن لديك ثلاثة جداول في مصنف ، الآن ، تريد دمج هذه الجداول في جدول واحد بناءً على أعمدة المفاتيح المقابلة للحصول على النتيجة كما هو موضح أدناه لقطة الشاشة. قد تكون هذه مهمة مزعجة لمعظمنا ، ولكن ، من فضلك لا تقلق ، هذه المقالة ، سأقدم بعض الطرق لحل هذه المشكلة.
  • تقسيم السلاسل النصية بواسطة المحدد إلى صفوف متعددة
  • عادة ، يمكنك استخدام ميزة Text to Column لتقسيم محتويات الخلية إلى أعمدة متعددة بواسطة محدد معين ، مثل الفاصلة ، والنقطة ، والفاصلة المنقوطة ، والشرطة المائلة ، وما إلى ذلك ، ولكن ، في بعض الأحيان ، قد تحتاج إلى تقسيم محتويات الخلية المحددة إلى صفوف متعددة وكرر البيانات من الأعمدة الأخرى كما هو موضح أدناه. هل لديك أي طرق جيدة للتعامل مع هذه المهمة في Excel؟ سيقدم هذا البرنامج التعليمي بعض الطرق الفعالة لإكمال هذه المهمة في Excel.
  • تقسيم محتويات الخلايا متعددة الأسطر إلى صفوف/أعمدة منفصلة
  • لنفترض أن لديك محتوى خلية متعدد الأسطر مفصول ب Alt + Enter ، والآن تحتاج إلى تقسيم المحتويات متعددة الأسطر إلى صفوف أو أعمدة منفصلة ، ماذا يمكنك أن تفعل؟ في هذا المقال ، ستتعلم كيفية تقسيم محتويات الخلايا متعددة الأسطر بسرعة إلى صفوف أو أعمدة منفصلة.

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

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


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

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (312)
Rated 5 out of 5 · 2 ratings
This comment was minimized by the moderator on the site
Sub SplitDataByColWorkbook()
Dim lr As Long
Dim ws As Worksheet
Dim vcol As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Workbook
Dim wb As Workbook


Set wb = ThisWorkbook
Set ws = wb.Sheets(1) ' Assuming you want to work with the first sheet in the workbook

On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Select Header Rows", Type:=8)
If xTRg Is Nothing Then Exit Sub

On Error Resume Next
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Select Split Column", Type:=8)
If xVRg Is Nothing Then Exit Sub

vcol = xVRg.Column
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"

Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet'!A1)") Then
Set xWS = Workbooks.Add
Else
Set xWS = Workbooks.Add
End If

Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Activate

For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear

For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
Set xWS = Workbooks.Add
Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWSTRg.Range("A" & (titlerow + xTRg.Rows.Count))
xWSTRg.Columns.AutoFit
xWS.SaveAs myarr(i) & ".xlsx" ' Change the file name as needed
xWS.Close SaveChanges:=False
Next

ws.AutoFilterMode = False
wb.Activate
Application.DisplayAlerts = True
End Sub
This comment was minimized by the moderator on the site
First of all, thank you for the macro.

I would like to ask if there is any way to maintain the column widths. My 'original' tab was completely formatted. However, after running the macro, it loses the column formatting and appears quite messy.

English is not my first language (sorry).

Thank you again!
Rated 5 out of 5
This comment was minimized by the moderator on the site
The original header is not copied in the split sheet.
This comment was minimized by the moderator on the site
This works wonderfully, thank you very much!!! Huge time-saver.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Hello,

I am having a hard time getting this code to work. When I run it, it just creates a duplicate sheet and does not split columns into multiple sheets.

I do have values that exceed 31 characters as well as special characters such as "-" and "()" in my column, how can I account for that without a lot of manual changes?
This comment was minimized by the moderator on the site
This worked great!!! One question... my formulas didn't transfer to each sheet correctly. What do I need to do differently to transfer the formulas?
Thank you!!!!!
This comment was minimized by the moderator on the site
Nice code, but it just copied everything to the new tables, named correctly though. So, the data filtering did not work at all, just copy paste.
This comment was minimized by the moderator on the site
When I run this using a small amount of data like the example it works. I'm trying to use this on a database with 400k + rows of data. When I run the macro, a second tab is created with just the header row and no data.
This comment was minimized by the moderator on the site
Hello, Ryan,

As you mentioned, the code works well for small data ranges, if there are lots of data, the code will not work properly.
In such situations, I recommend using the "Split Data" feature offered by Kutools for Excel. This powerful feature can greatly assist you in managing large amounts of data. To take advantage of this feature, you can download and install Kutools for Excel, which is available for a 30-day free trial.

Please have a try, thank you!
This comment was minimized by the moderator on the site
I've come across many solutions in VBA message boards for parsing data into worksheets or columns based upon filtering a particular column, but they all require a bit of tinkering and customization. What makes this so brilliant is that it is dynamic, user-friendly even for beginners (which gives it shareable utility), and copy/paste ready.

You rock.
This comment was minimized by the moderator on the site
Hi, Dane,
Thanks for your comment, glad this can help you! Have a good day!
This comment was minimized by the moderator on the site
When I try to split data from a different sheet, it copies and pastes the entire sheet into one sheet instead of multiple sheets. Could this be because the naming convention of the sheet I'm trying to split is similar to another sheet?
This comment was minimized by the moderator on the site
Hello, Giancarlo,

If the data in the column is same with a sheet name in the workbook, the sheet with the same name will be kept, other data will be split into separate sheet.
Thanks for your comment.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations