עוגיות לעזור לנו לספק השירותים שלנו. על ידי שימוש בשירותים שלנו, אתה מסכים לשימוש בעוגיות שלנו.
טיפ: שפות אחרות הן Google-Translated. אתה יכול לבקר את English גרסה של קישור זה.
התחבר
x
or
x
x
הירשם
x

or

כיצד לפצל נתונים לגליונות עבודה מרובים המבוססים על עמודה ב- Excel?

נניח שיש לך גליון עבודה עם שורות ענק של נתונים, ועכשיו, אתה צריך לפצל את הנתונים לגליונות עבודה מרובים על בסיס שם (ראה צילום מסך הבא), והשמות מוזנים באופן אקראי. אולי אתה יכול למיין אותם הראשון, ולאחר מכן להעתיק ולהדביק אותם אחד אחד לתוך גליונות עבודה חדשים אחרים. אבל זה צריך את הסבלנות כדי להעתיק ולהדביק שוב ושוב. היום, אני אדבר על כמה טריקים מהירים כדי לפתור את המשימה.

דוק פיצול נתונים לפי עמודות 1

פיצול נתונים לגליונות עבודה מרובים המבוססים על עמודה עם קוד VBA

פיצול נתונים לגליונות עבודה מרובים המבוססים על עמודה עם Kutools עבור Excel


פיצול נתונים לגליונות עבודה מרובים בהתבסס על עמודות או שורות ספציפיות בגיליון העבודה:

אם אתה רוצה לפצל גליון גדול לתוך גיליונות מרובים בהתבסס על נתוני טור מסוים או שורות ספירה, Kutools עבור Excel's פיצול נתונים תכונה יכולה לעזור לך לפתור את המשימה במהירות ובקלות.

דוק פיצול נתונים לפי עמודות 6

Kutools עבור Excel: עם יותר מ 200 שימושי תוספות של Excel, ללא תשלום כדי לנסות ללא הגבלה 60 ימים. הורד ניסיון ללא תשלום עכשיו!


פיצול נתונים לגליונות עבודה מרובים המבוססים על עמודה עם קוד VBA


אם אתה רוצה לפצל את הנתונים על בסיס ערך העמוד במהירות ובאופן אוטומטי, קוד VBA הבא הוא בחירה טובה. אנא בצע את הפעולות הבאות:

1. החזק את ALT + F11 מפתחות כדי לפתוח את Microsoft Visual Basic עבור יישומים חלון.

2. לחץ הַבלָעָה > מודול, והדבק את הקוד הבא בחלון המודול.

Sub parse_data()
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
vcol = 1        
Set ws = Sheets("Master sheet")        
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"            
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

הערות: בקוד לעיל:

  • vcol = 1 , המספר 1 הוא מספר העמודה שברצונך לפצל את הנתונים בהתבסס על.
  • הגדר ws = גיליונות ("גיליון ראשי"), דף ראשי הוא שם הגיליון שבו ברצונך להחיל קוד זה.
  • title = "A1: C1" , A1: C1 הוא טווח הכותרת.

כולם משתנים, אתה יכול לשנות אותם כצורך שלך.

3. לאחר מכן לחץ על F5 כדי להפעיל את הקוד, כל הנתונים בגליון העבודה הפעיל מחולקים לגליונות עבודה מרובים לפי ערך העמודה. וגליונות העבודה המפוצלים נקראים בשמות התאים המפוצלים. ראה צילום מסך:

דוק פיצול נתונים לפי עמודות 2

הערות: גליונות העבודה המפוצלים ממוקמים בסוף חוברת העבודה שבה נמצאת גליון העבודה הראשי.


פיצול נתונים לגליונות עבודה מרובים המבוססים על עמודה עם Kutools עבור Excel

בתור Excel Excel, קוד VBA ארוך זה קצת קשה עבורנו, ורובנו אפילו לא יודע איך לשנות את הקוד כמו הצורך שלנו.

הנה, אני אציג לך כלי רב תכליתיים -Kutools עבור Excel, פיצול נתונים כלי לא רק יכול לעזור לך לפצל נתונים לגליונות עבודה מרובים על בסיס עמודה, אבל גם יכול לפצל נתונים לפי שורות לספור.

Kutools עבור Excel : עם יותר מ 300 שימושי תוספות של Excel, ללא תשלום כדי לנסות ללא הגבלה 60 ימים.

אם התקנת Kutools עבור Excel, אנא בצע את הפעולות הבאות:

1. בחר את טווח הנתונים שברצונך לפצל.

2. לחץ Kutools פלוס > גיליון עבודה > פיצול נתונים, ראה צילום מסך:

דוק פיצול נתונים לפי עמודות 3

3. ב פיצול נתונים לגליונות עבודה מרובים תיבת הדו שיח, עליך:

1). בחר עמודה ספציפית אפשרות ב פיצול מבוסס על , ובחר את ערך העמודה שבו ברצונך לפצל את הנתונים בהתבסס על הרשימה הנפתחת. (אם הנתונים שלך יש כותרות ואתה רוצה להכניס אותם לתוך כל גיליון עבודה חדש לפצל, אנא בדוק הנתונים שלי מכילים כותרות אוֹפְּצִיָה.)

2). לאחר מכן תוכל לציין את שמות גליון העבודה המפוצלים, תחת שם גליונות עבודה חדשים בסעיף, ציין את כללי השמות בגליון העבודה מתוך חוקי הרשימה הנפתחת, אתה יכול להוסיף את קידומת or סִיוֹמֶת עבור שמות הסדין גם כן.

3). לחץ על OK לַחְצָן. ראה צילום מסך:

דוק פיצול נתונים לפי עמודות 4

4. כעת הנתונים מחולקים למספר גליונות עבודה בחוברת עבודה חדשה.

דוק פיצול נתונים לפי עמודות 5

לחץ כדי להוריד Kutools עבור Excel ניסיון ללא תשלום עכשיו!


פיצול נתונים לגליונות עבודה מרובים המבוססים על עמודה עם Kutools עבור Excel

Kutools עבור Excel כולל יותר מ 300 כלי Excel שימושי. חינם ללא הגבלה ב- 60 ימים. הורד את גרסת הניסיון בחינם עכשיו!


כתבות קשורות:

כיצד לפצל נתונים לגליונות עבודה מרובים לפי שורות?



כלי פרודוקטיביות מומלצים

הכרטיסייה 'משרד'

כוכב זהב תביא כרטיסיות שימושיות ל- Excel ולתוכנות Office אחרות, בדיוק כמו Chrome, Firefox ו- Internet Explorer החדש.

Kutools עבור Excel

כוכב זהב מדהים! הגדל את הפרודוקטיביות שלך ב- 5 דקות. לא צריך שום כישורים מיוחדים, לשמור שעתיים כל יום!

כוכב זהב 300 תכונות חדשות עבור Excel, להפוך את Excel הרבה יותר קל ורב עוצמה:

  • מיזוג תאים / שורות / עמודות מבלי לאבד נתונים.
  • שלב ולאחד מספר גיליונות וחוברות עבודה.
  • השווה טווחים, העתק טווחים מרובים, המרת טקסט עד תאריך, יחידת המרת מטבע.
  • ספירה לפי צבעים, סכימות החלפה, מתקדם מיון ו סופר מסנן,
  • עוד בחר / הוסף / מחק / טקסט / עיצוב / קישור / תגובה / חוברות עבודה / גליונות עבודה ...

צילום מסך של Kutools עבור Excel

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Jason · 1 months ago
    This formula is great, works perfectly for me.
    I want to split out data based on a location, which is in column 1. Which this does.
    However, is it possible to also split out based on column 2, for example. Built and Not Built. So a secondary condition also?
  • To post as a guest, your comment is unpublished.
    jose · 1 months ago
    can someone help please im using this but i keep getting to many columns. i have to keep deleting rows every time i use this.

    This is what im using


    Sub parse_data()
    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
    vcol = 1
    Set ws = Sheets("sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:AN1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 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
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    avinash · 1 months ago
    Thanks for VBA, it works great. In addition to that question, I have column which is dependent. So when i select some value my column values get changed hence I need vba solution to replace earlier split worksheet to replace with new value of columns. Can anyone help me out.?

    Thanks in advance
  • To post as a guest, your comment is unpublished.
    JP Tontegode · 1 months ago
    Is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
  • To post as a guest, your comment is unpublished.
    Sebastian · 1 months ago
    Effectively, this code does work great. I wrote an additional code so that I could get subtotal on certain columns but it has not worked great. So I tried running the subtotals from the master list, but afterwards when I use this macro it create a whole new tab for the Grand total row. So I am getting two two tabs per split. the first one is fine because it splits with the grand totals, but then creates a second one with just the grand total row. Any help as to how to modify this.
    This is the code that I am currently using:
    Sub parse_data()
    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
    vcol = 3
    Set ws = Sheets("Master sheet")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:R1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 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
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub