Cách tách dữ liệu trong 1 dòng thành nhiều dòng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
L

lamhongquanghp

Thành viên mới
Tham gia
31/8/11
Bài viết
5
Được thích
0
Em có 1 file dữ liệu có 1 dòng chưa nhiều dữ liệu cần tách ra mỗi dữ liệu 1 dòng. Bác nào có công thức làm chỉ em với
Đây là dữ liệu của em
Ví dụ: với số công bố 34520 thì có 9 mã hàng, giờ em muốn tách ra thành 9 dòng, mỗi dòng là 2 cột gồm 1 cột ghi số công bố 34520 và cột còn lại ghi 1 trong 9 mã hàng trên
Đa tạ các bác
 

File đính kèm

lamhongquanghp đã viết:
Em có 1 file dữ liệu có 1 dòng chưa nhiều dữ liệu cần tách ra mỗi dữ liệu 1 dòng. Bác nào có công thức làm chỉ em với
Đây là dữ liệu của em
Ví dụ: với số công bố 34520 thì có 9 mã hàng, giờ em muốn tách ra thành 9 dòng, mỗi dòng là 2 cột gồm 1 cột ghi số công bố 34520 và cột còn lại ghi 1 trong 9 mã hàng trên
Đa tạ các bác
Nhấp chuột vào đây để mở rộng...
bài này công thức thì chưa biết có hay không, cho dù có đi chăng nữa thì cũng rất chậm... bài này giải quyết bằng macro thì ok không có vấn đề gì?
 
lamhongquanghp đã viết:
Em có 1 file dữ liệu có 1 dòng chưa nhiều dữ liệu cần tách ra mỗi dữ liệu 1 dòng. Bác nào có công thức làm chỉ em với
Đây là dữ liệu của em
Ví dụ: với số công bố 34520 thì có 9 mã hàng, giờ em muốn tách ra thành 9 dòng, mỗi dòng là 2 cột gồm 1 cột ghi số công bố 34520 và cột còn lại ghi 1 trong 9 mã hàng trên
Đa tạ các bác
Nhấp chuột vào đây để mở rộng...
Bạn xem file nhé.
 

File đính kèm

phihndhsp đã viết:
bài này công thức thì chưa biết có hay không, cho dù có đi chăng nữa thì cũng rất chậm... bài này giải quyết bằng macro thì ok không có vấn đề gì?
Nhấp chuột vào đây để mở rộng...
Bác có thể giải quyết bằng Macro ra 1 sheet bên cạnh giúp em ko?
Bác có hướng giải quyết bằng hàm không hướng cho em bước đi cơ bản để em tự nghiên cứu hàm cũng được ạ :D
 
lamhongquanghp đã viết:
Em có 1 file dữ liệu có 1 dòng chưa nhiều dữ liệu cần tách ra mỗi dữ liệu 1 dòng. Bác nào có công thức làm chỉ em với
Đây là dữ liệu của em
Ví dụ: với số công bố 34520 thì có 9 mã hàng, giờ em muốn tách ra thành 9 dòng, mỗi dòng là 2 cột gồm 1 cột ghi số công bố 34520 và cột còn lại ghi 1 trong 9 mã hàng trên
Đa tạ các bác
Nhấp chuột vào đây để mở rộng...
Bạn tham khảo:
PHP: 
Sub abc()
    Dim x, dArr(), Sp
    Dim i As Long, j As Long, k As Long, n As Long
    Application.ScreenUpdating = False
    With Range("A4").CurrentRegion
        x = .Value
        ReDim dArr(1 To UBound(x) * 5, 1 To UBound(x, 2))
        For i = 1 To UBound(x)
            Sp = Split(x(i, 3), ",")
            For j = 0 To UBound(Sp)
                If Len(Sp(j)) Then
                    k = k + 1
                    For n = 1 To UBound(x, 2) - 1
                        dArr(k, n) = x(i, n)
                    Next n
                    dArr(k, n) = Sp(j)
                End If
            Next j
        Next i
        .Resize(k).Value = dArr()
    End With
    Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
dùng công thức khác để tách dữ liệu
 

File đính kèm

lamhongquanghp đã viết:
Em có 1 file dữ liệu có 1 dòng chưa nhiều dữ liệu cần tách ra mỗi dữ liệu 1 dòng. Bác nào có công thức làm chỉ em với
Đây là dữ liệu của em
Ví dụ: với số công bố 34520 thì có 9 mã hàng, giờ em muốn tách ra thành 9 dòng, mỗi dòng là 2 cột gồm 1 cột ghi số công bố 34520 và cột còn lại ghi 1 trong 9 mã hàng trên
Đa tạ các bác
Nhấp chuột vào đây để mở rộng...

Code:
Sub Transpose_range()
Dim SoDong As Long
Dim Arr As Variant
SoDong = Sheet1.Range("B5").End(xlDown).Row
Sheet2.Range("B2").Resize(, SoDong - 3) = WorksheetFunction.Transpose(Sheet1.Range("B5:B" & SoDong))
For i = 5 To SoDong
If Sheet1.Cells(i, "C").Value Like "*,*" Then
Arr = Split(Sheet1.Cells(i, "C"), ", ")
Sheet2.Cells(3, i - 3).Resize(UBound(Arr) + 1, 1) = WorksheetFunction.Transpose(Arr)
Else
Sheet2.Cells(3, i - 3) = Sheet1.Cells(i, "C")
End If
Next
End Sub

File đính kèm.
 

File đính kèm

quoc chinh đã viết:
Bạn xem giúp mình tự động tách dong theo cột số lượng với
Nhấp chuột vào đây để mở rộng...
1/ "Tách dong theo cột số lượng": Khó hiểu. Viết xong cũng chẳng đọc lại xem mình viết có đủ dấu, chính tả không.
2/ Công "đào mộ" cũng đáng để giúp 1 Sub "cùi bắp"
PHP: 
Option Explicit

Public Sub Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, R As Long, x As Long
    sArr = Range("A1", Range("A1000000").End(xlUp)).Resize(, 10).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 50, 1 To 3)
For I = 2 To R
    For J = 3 To 10
        x = Val(sArr(I, J))
        If x > 0 Then
            For N = 1 To x
                K = K + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(1, J)
            Next N
        End If
    Next J
Next I
Range("N2").Resize(100000, 3).ClearContents
Range("N2").Resize(K, 3) = dArr
End Sub
 
Ba Tê đã viết:
1/ "Tách dong theo cột số lượng": Khó hiểu. Viết xong cũng chẳng đọc lại xem mình viết có đủ dấu, chính tả không.
2/ Công "đào mộ" cũng đáng để giúp 1 Sub "cùi bắp"
PHP: 
Option Explicit

Public Sub Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, J As Long, N As Long, K As Long, R As Long, x As Long
    sArr = Range("A1", Range("A1000000").End(xlUp)).Resize(, 10).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 50, 1 To 3)
For I = 2 To R
    For J = 3 To 10
        x = Val(sArr(I, J))
        If x > 0 Then
            For N = 1 To x
                K = K + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = sArr(I, 2)
                dArr(K, 3) = sArr(1, J)
            Next N
        End If
    Next J
Next I
Range("N2").Resize(100000, 3).ClearContents
Range("N2").Resize(K, 3) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Cho phép em xin được mở rộng thêm tình huống này chút.

Nhờ Thầy và mọi người hướng dẫn thêm giúp trường hợp muốn tách dữ liệu các cột theo từng nhóm như kết quả file đính kèm thì cần chỉnh code như thế nào?

Mong được mọi người giúp đỡ!
 

File đính kèm

quick87 đã viết:
Cho phép em xin được mở rộng thêm tình huống này chút.

Nhờ Thầy và mọi người hướng dẫn thêm giúp trường hợp muốn tách dữ liệu các cột theo từng nhóm như kết quả file đính kèm thì cần chỉnh code như thế nào?

Mong được mọi người giúp đỡ!
Nhấp chuột vào đây để mở rộng...
Cột số liệu bạn lấy như nào thế
 
BuiQuangThuan đã viết:
Cột số liệu bạn lấy như nào thế
Nhấp chuột vào đây để mở rộng...
Hoàng Tuấn 868 đã viết:
Có vẻ copy nguyên cột xuống thôi thì phải bạn ạ.
Nhấp chuột vào đây để mở rộng...

Cảm ơn hai bạn đã quan tâm.
Trường hợp này là mình cần dồn các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm bạn ah!

1638676878600.png

File kết quả cần xử lý mình có gửi lại ở bài trên!
 
quick87 đã viết:
Trường hợp này là mình cần dồn các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm bạn ah!
Nhấp chuột vào đây để mở rộng...
Nếu thế thì sort theo cái cột Q, Hạng mục ấy là được chứ có làm gì nữa đâu
 
BuiQuangThuan đã viết:
Nếu thế thì sort theo cái cột Q, Hạng mục ấy là được chứ có làm gì nữa đâu
Nhấp chuột vào đây để mở rộng...
Mình có chỉnh lại code một chút nhưng kết quả chưa được như ý đồ bài #12, mong bạn và mọi người chỉnh giúp:
PHP: 
Public Sub Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), i As Long, J As Long, N As Long, K As Long, R As Long, x As Long
    sArr = Range("A1", Range("A1000000").End(xlUp)).Resize(, 10).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 50, 1 To 4)
For i = 2 To R
    For J = 3 To 10
        x = Val(sArr(i, J))
        If x > 0 Then
            For N = 1 To x
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, 2) = sArr(i, 2)
                dArr(K, 3) = sArr(1, J)
                dArr(K, 4) = sArr(i, J)
            Next N
        End If
    Next J
Next i
Range("N2").Resize(100000, 4).ClearContents
Range("N2").Resize(K, 4) = dArr
Range("N1", Range("N1000000").End(xlUp)).Resize(, 4).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
Range("N1", Range("N1000000").End(xlUp)).Resize(, 4).Sort Key1:=Range("P2"), Order1:=xlAscending, Key2:=Range("N2"), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
End Sub
 
quick87 đã viết:
Mình có chỉnh lại code một chút nhưng kết quả chưa được như ý đồ bài #12, mong bạn và mọi người chỉnh giúp:
Nhấp chuột vào đây để mở rộng...
Thử code coi đúng ý không?
Mã: 
Sub XYZ()
    Dim Arr(), Res(), i&, J&, iRow&, R&, ii&, K&
    With Sheet1
        R = Application.WorksheetFunction.Sum(.Range("C:J")) * 2
        If R > .Rows.Count Then MsgBox "Khong du dong de chua": Exit Sub
        iRow = .Range("B" & Rows.Count).End(3).Row
        Arr = .Range("A1:J" & iRow).Value
        ReDim Res(1 To R, 1 To 4)
        For i = 2 To UBound(Arr, 1)
            For J = 3 To UBound(Arr, 2)
                If Val(Arr(i, J)) > 0 Then
                    For ii = 1 To Arr(i, J)
                        K = K + 1
                        Res(K, 1) = Arr(i, 1)
                        Res(K, 2) = Arr(i, 2)
                        Res(K, 3) = Arr(i, J)
                        Res(K, 4) = Arr(1, J)
                    Next
                End If
            Next
        Next
        .Range("R2:R" & .Rows.Count).ClearContents
        .Range("R2").Resize(K, 4).Value = Res
        .Range("R2").Resize(K, 4).Sort .Range("U1"), xlAscending
    End With
End Sub
 
BuiQuangThuan đã viết:
Thử code coi đúng ý không?
Mã: 
Sub XYZ()
    Dim Arr(), Res(), i&, J&, iRow&, R&, ii&, K&
    With Sheet1
        R = Application.WorksheetFunction.Sum(.Range("C:J")) * 2
        If R > .Rows.Count Then MsgBox "Khong du dong de chua": Exit Sub
        iRow = .Range("B" & Rows.Count).End(3).Row
        Arr = .Range("A1:J" & iRow).Value
        ReDim Res(1 To R, 1 To 4)
        For i = 2 To UBound(Arr, 1)
            For J = 3 To UBound(Arr, 2)
                If Val(Arr(i, J)) > 0 Then
                    For ii = 1 To Arr(i, J)
                        K = K + 1
                        Res(K, 1) = Arr(i, 1)
                        Res(K, 2) = Arr(i, 2)
                        Res(K, 3) = Arr(i, J)
                        Res(K, 4) = Arr(1, J)
                    Next
                End If
            Next
        Next
        .Range("R2:R" & .Rows.Count).ClearContents
        .Range("R2").Resize(K, 4).Value = Res
        .Range("R2").Resize(K, 4).Sort .Range("U1"), xlAscending
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Trước hết, mình cảm ơn bạn đã quan tâm và giúp đỡ!
Mình xin lỗi do mình trình bày vấn đề chưa rõ, kết quả mình cần trường hợp này là mình muốn "Gom các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm", kết quả như mẫu file đính kèm. Nhờ bạn và mọi người xem thêm giúp nhé!
 

File đính kèm

quick87 đã viết:
Trước hết, mình cảm ơn bạn đã quan tâm và giúp đỡ!
Mình xin lỗi do mình trình bày vấn đề chưa rõ, kết quả mình cần trường hợp này là mình muốn "Gom các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm", kết quả như mẫu file đính kèm. Nhờ bạn và mọi người xem thêm giúp nhé!
Nhấp chuột vào đây để mở rộng...
Bạn nên xoá dữ liệu bớt đi. Để lại 1 ít thôi. Và kết quả điền bằng tay xem thế nào. mình vẫn chưa thông được cái đoạn
Gom các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm
này luôn ấy
 
BuiQuangThuan đã viết:
Bạn nên xoá dữ liệu bớt đi. Để lại 1 ít thôi. Và kết quả điền bằng tay xem thế nào. mình vẫn chưa thông được cái đoạn
Gom các cột có số liệu khác 0 từ Cột C đến Cột J về lại một cột theo từng nhóm
này luôn ấy
Nhấp chuột vào đây để mở rộng...
Mình gửi lại file kết quả đã lược bớt dữ liệu.

1638786763367.png

Khi thực hiện thao tác thủ công bằng tay sẽ thực hiện các bước như sau:
  1. Filter Cột A:C, lọc những giá trị > 0, copy vùng lọc được sang Cột N:Q;
  2. Tiếp đó, Filter Cột D, lọc những giá trị > 0, copy vùng lọc được (Cột A, B, D), copy paste nối tiếp sang vùng ở Cột N:Q;
  3. Filter Cột E, lọc những giá trị > 0, copy vùng lọc được (Cột A, B, E), copy paste nối tiếp sang vùng ở Cột N:Q;
  4. ....
  5. Làm tương tự với những Cột còn lại cho tới hết những cột còn lại.
 

File đính kèm

quick87 đã viết:
Mình gửi lại file kết quả đã lược bớt dữ liệu.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code
Mã: 
Sub XYZ()
    Dim Arr(), Res(), i&, J&, iRow&, K&
With Sheet1
    iRow = .Range("B" & Rows.Count).End(3).Row
    Arr = .Range("A1:J" & iRow).Value
    ReDim Res(1 To UBound(Arr, 1) * (UBound(Arr, 2) - 2), 1 To 4)
    For J = 3 To UBound(Arr, 2)
        For i = 2 To UBound(Arr, 1)
            If Val(Arr(i, J)) > 0 Then
                K = K + 1
                Res(K, 1) = Arr(i, 1)
                Res(K, 2) = Arr(i, 2)
                Res(K, 3) = Arr(1, J)
                Res(K, 4) = Arr(i, J)
            End If
        Next
    Next
    .Range("N2:Q" & .Rows.Count).ClearContents
    .Range("N2").Resize(K, 4).Value = Res
End With
End Sub
 
BuiQuangThuan đã viết:
Chỉnh lại code
Mã: 
Sub XYZ()
    Dim Arr(), Res(), i&, J&, iRow&, K&
With Sheet1
    iRow = .Range("B" & Rows.Count).End(3).Row
    Arr = .Range("A1:J" & iRow).Value
    ReDim Res(1 To UBound(Arr, 1) * (UBound(Arr, 2) - 2), 1 To 4)
    For J = 3 To UBound(Arr, 2)
        For i = 2 To UBound(Arr, 1)
            If Val(Arr(i, J)) > 0 Then
                K = K + 1
                Res(K, 1) = Arr(i, 1)
                Res(K, 2) = Arr(i, 2)
                Res(K, 3) = Arr(1, J)
                Res(K, 4) = Arr(i, J)
            End If
        Next
    Next
    .Range("N2:Q" & .Rows.Count).ClearContents
    .Range("N2").Resize(K, 4).Value = Res
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Kết quả đúng như mình cần rồi. Chân thành cảm bạn!
 
Thì bạn cứ Copy & dán thôi;
Nếu muốn đỡ vất vả thì thực hiện việc Copy & dán nhuần nghuyễn, sau đó mở bộ thu macro lên là OK mà!
Nếu thấy các câu lệnh trong macro lôi thôi thì gởi lên anh cộng đồng cô gọn cho duyên dáng thêm!
Chúc ngày nghỉ cuối tuần vui vẻ!
 
SA_DQ đã viết:
Thì bạn cứ Copy & dán thôi;
Nếu muốn đỡ vất vả thì thực hiện việc Copy & dán nhuần nghuyễn, sau đó mở bộ thu macro lên là OK mà!
Nếu thấy các câu lệnh trong macro lôi thôi thì gởi lên anh cộng đồng cô gọn cho duyên dáng thêm!
Chúc ngày nghỉ cuối tuần vui vẻ!
Nhấp chuột vào đây để mở rộng...
ANH CHỊ CÓ CÁCH NÀO CHỈ E VỚI Ạ, E MỚI TÌM HỌC CÒN NHIỀU THỨ KHÔNG BIẾT Ạ!
 
PHP: 
Sub CopyDongThanhBang()
 Dim Col As Integer, J As Long, Dong As Long

 Col = [B1].CurrentRegion.Cells.Count
 Dong = 4
 For J = 1 To Col Step 5
    Cells(1, J).Resize(, 5).Copy Destination:=Cells(Dong, "A")
    Dong = Dong + 1
 Next J
End Sub
 
Bài viết toàn chữ hoa là phạm quy. Hỏng biết mấy người nghiện code có biết hông? Hay đối với cơn nghiện thì cái gì cũng phê được?
 
Đúng, bài viết toàn chữ in đang là sai;
& cái sai này đã có người được phân công (phải nghiện) lo trước; /(HÀ, KHÀ, /(hà, khà, . . . . .
Trước mình cũng tham gia, nhưng giờ thì MAC KE NO. . . . .!

CB05.jpg
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

nkd80
Thiết lập công thức điền mức hoa hồng cho nhân viên (2 người xem)
Trả lời
1
Đọc
32
HieuCD
H
Phonglinh0902
  • Question Question
Hỗ trợ tìm mã thiếu sổ kế toán (3 sổ kế toán) (3 người xem)
Trả lời
2
Đọc
38
SA_DQ
SA_DQ
Gà Công Nghệ
Tách ngày giờ trong excel
Trả lời
6
Đọc
83
SA_DQ
SA_DQ
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
471
Đọc
61K
pycckuu410
pycckuu410
N
Xin các công thức trong bài excel này ạ
Trả lời
3
Đọc
100
dungpham01
D
phuongnam366377
✨ **Chuyện hài với AI** ✨
    • Buồn
    • Thích
Trả lời
6
Đọc
309
SA_DQ
SA_DQ
L
Nhờ mở file Excel quên Pass
Trả lời
1
Đọc
57
khang2303
khang2303
H
Tìm dữ liệu trùng (1 người xem)
Trả lời
2
Đọc
84
LOGANWover
L
phuongnam366377
Tấu hài công nghệ: DLL miễn phí và những cú “ảo thuật” rác rưởi
Trả lời
0
Đọc
77
phuongnam366377
phuongnam366377
Nguyễn Duy Tuân
Hướng dẫn lập trình Delphi cơ bản từ Bluesofts.net
    • Thích
Trả lời
57
Đọc
15K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
phuongnam366377
COM DLL `ScriptHelper.RegExp` – Thay thế VBScript.RegExp trong VBA
    • Thích
Trả lời
14
Đọc
367
phuongnam366377
phuongnam366377
L
[Nhờ giúp đỡ] Chọn n mã hàng ngẫu nhiên sao cho tổng giá tiền bằng một số cho trước
Trả lời
14
Đọc
435
Hoàng Tuấn 868
H
Gà Công Nghệ
Đếm số lượng khi lọc dữ liệu
Trả lời
2
Đọc
92
Gà Công Nghệ
Gà Công Nghệ
V
Xin giúp đỡ viết code tách dữ liệu ra nhiều sheet
Trả lời
8
Đọc
245
HUONGHCKT
H
PhanTuHuong
Sách Lập trình VBA trong AutoCAD và Civil 3D đọc online miễn phí!
    • Thích
    • Yêu thích
Trả lời
39
Đọc
4K
huhumalu
H
PhanTuHuong
Bàn về bảo mật dự án VB6, VB.NET, Delphi...
Trả lời
39
Đọc
863
phuongnam366377
phuongnam366377
D
1 Công thức ra cuốn lịch
    • Cảm ơn
    • Cười
Trả lời
16
Đọc
323
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Xin giúp đỡ về hàm thay thế trong văn bản
Trả lời
6
Đọc
103
khuong182018
khuong182018
V
Lỗi không insert được thêm dòng trong excel (1 người xem)
Trả lời
3
Đọc
179
Maika8008
Maika8008
tuyetnhi
Tự động nhận diện số thứ tự trang in trên file PDF
Trả lời
9
Đọc
285
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom