Cookies membantu kami memberikan layanan kami. Dengan menggunakan layanan kami, Anda setuju untuk kami menggunakan cookies.
Kiat: Bahasa lain adalah Terjemahan-Google. Anda dapat mengunjungi English versi link ini
Masuk
x
or
x
x
Daftar
x

or

Bagaimana cara membagi data menjadi beberapa lembar kerja berdasarkan kolom di Excel?

Misalkan Anda memiliki lembar kerja dengan deretan data yang besar, dan sekarang, Anda perlu membagi data menjadi beberapa lembar kerja berdasarkan pada Nama kolom (lihat screenshot berikut), dan nama-nama dimasukkan secara acak. Mungkin Anda bisa mengurutkan mereka terlebih dahulu, lalu salin dan tempelkan mereka satu demi satu ke lembar kerja baru lainnya. Tetapi ini membutuhkan kesabaran Anda untuk menyalin dan menempel berulang kali. Hari ini, saya akan berbicara tentang beberapa trik cepat untuk menyelesaikan tugas ini.

dokumen membagi data berdasarkan kolom 1

Split data menjadi beberapa lembar kerja berdasarkan kolom dengan kode VBA

Split data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel


Pisahkan data ke dalam beberapa lembar kerja berdasarkan jumlah kolom atau baris tertentu di lembar kerja:

Jika Anda ingin membagi lembar kerja besar menjadi beberapa lembar berdasarkan data kolom tertentu atau jumlah baris, Kutools for Excel's Data split fitur dapat membantu Anda menyelesaikan tugas ini dengan cepat dan mudah.

dokumen membagi data berdasarkan kolom 6

Kutools for Excel: dengan lebih dari 200 berguna Excel add-in, bebas untuk mencoba tanpa batasan dalam 60 hari. Download dan uji coba gratis Sekarang!


Split data menjadi beberapa lembar kerja berdasarkan kolom dengan kode VBA


Jika Anda ingin membagi data berdasarkan nilai kolom dengan cepat dan otomatis, kode VBA berikut adalah pilihan yang baik. Tolong lakukan seperti ini:

1. Tahan ALT + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Klik Menyisipkan > Modul, dan paste kode berikut di Module Window.

Sub Splitdatabycol()
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
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").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. Lalu tekan F5 kunci untuk menjalankan kode, dan kotak prompt muncul untuk mengingatkan Anda memilih baris tajuk, lihat tangkapan layar:

dokumen membagi data berdasarkan kolom 7

4. Dan kemudian, klik OK tombol, dan di kotak prompt kedua, silakan pilih data kolom yang ingin Anda bagi berdasarkan, lihat tangkapan layar:

dokumen membagi data berdasarkan kolom 8

5. Lalu klik OK, dan semua data di lembar kerja aktif dibagi menjadi beberapa lembar kerja dengan nilai kolom. Dan lembar kerja split dinamai dengan nama sel split. Lihat tangkapan layar:

dokumen membagi data berdasarkan kolom 2

Catatan: Lembar kerja split ditempatkan di akhir buku kerja tempat lembar kerja utama berada.


Split data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel

Sebagai pemula Excel, kode VBA yang panjang ini agak sulit bagi kita, dan kebanyakan dari kita bahkan tidak tahu bagaimana memodifikasi kode sebagai kebutuhan kita.

Di sini, saya akan memperkenalkan alat multifungsi -Kutools for Excel, nya Data split utilitas tidak hanya dapat membantu Anda untuk membagi data menjadi beberapa lembar kerja berdasarkan kolom, namun juga dapat membagi data dengan jumlah baris.

Kutools for Excel : dengan lebih dari 300 berguna Excel add-in, bebas untuk mencoba tanpa batasan dalam 60 hari.

Jika sudah terpasang Kutools for Excel, mohon lakukan hal berikut:

1. Pilih kisaran data yang ingin Anda bagi.

2. Klik Kutools Plus > Lembar Kerja > Data split, lihat tangkapan layar:

dokumen membagi data berdasarkan kolom 3

3. di Split Data menjadi Multiple Worksheets kotak dialog, Anda perlu:

1). Memilih Kolom tertentu pilihan dalam Split berdasarkan bagian, dan pilih nilai kolom yang ingin Anda bagi untuk membagi data berdasarkan daftar drop-down. (Jika data Anda memiliki header dan Anda ingin memasukkannya ke dalam lembar kerja split yang baru, tolong periksa Data saya memiliki header pilihan.)

2). Kemudian Anda bisa menentukan nama worksheet split, di bawah Nama lembar kerja baru bagian, tentukan aturan nama worksheet dari aturan daftar drop down, Anda bisa menambahkan Awalan or Akhiran untuk nama sheet juga

3). Klik OK tombol. Lihat tangkapan layar

dokumen membagi data berdasarkan kolom 4

4. Sekarang data dibagi menjadi beberapa lembar kerja di buku kerja baru.

dokumen membagi data berdasarkan kolom 5

Klik untuk Download Kutools for Excel dan free trial Now!


Split data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel

Kutools for Excel termasuk lebih dari 300 berguna alat Excel. Bebas untuk mencoba tanpa batasan dalam 60 hari. Download uji coba gratis sekarang juga!


Artikel terkait:

Bagaimana membagi data menjadi beberapa lembar kerja dengan jumlah baris?



Alat Produktifitas yang Direkomendasikan

Office Tab

Bintang emas1 Bawa tab yang berguna ke Excel dan perangkat lunak Office lainnya, seperti Chrome, Firefox dan Internet Explorer baru.

Kutools for Excel

Bintang emas1 Menakjubkan! Tingkatkan produktivitas Anda dalam 5 menit. Tidak perlu keahlian khusus, hemat dua jam setiap hari!

Bintang emas1 300 Fitur Baru untuk Excel, Membuat Excel Lebih Mudah dan Hebat:

  • Gabungkan Sel / Baris / Kolom tanpa Kehilangan Data.
  • Menggabungkan dan mengkonsolidasikan beberapa lembar dan buku kerja.
  • Bandingkan Range, Copy Multiple Ranges, Konversi Teks ke Tanggal, Konversi Unit dan Mata Uang.
  • Hitung dengan Warna, Pager Subtotals, Filter Sort dan Super Tingkat Lanjut,
  • Lebih Pilih / Sisipkan / Hapus / Teks / Format / Link / Komentar / Buku Kerja / Lembar Kerja Alat ...

Tembakan layar dari Kutools untuk 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.
    Rudi Miller · 4 days ago
    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: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
  • 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!