Tách thành nhiều dòng theo điều kiện

Liên hệ QC

dahoydu

Thành viên mới
Tham gia
19/10/09
Bài viết
40
Được thích
1
Anh/chị cho em hỏi mình có cách nào tách dữ liệu thành nhiều dòng dựa theo điều kiện.
Vd: E có 1 bảng "data" vào như file đính kèm, tương ứng điều kiện của "number_subject", sẽ hiển thị kết quả tương ứng như sheet "result".
 

File đính kèm

  • Book1.xlsx
    9.6 KB · Đọc: 13
Anh/chị cho em hỏi mình có cách nào tách dữ liệu thành nhiều dòng dựa theo điều kiện.
Vd: E có 1 bảng "data" vào như file đính kèm, tương ứng điều kiện của "number_subject", sẽ hiển thị kết quả tương ứng như sheet "result".
Bạn thử dùng code này nhé:
Mã:
Option Explicit

Sub TachDuLieu()
Dim sArr(), dArr(), I&, J&, K&, sU1&, sU2&, dU1&, dU2&
With Sheets("Data")
    sArr = .Range("A2:D" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    sU1 = UBound(sArr, 1)
    sU2 = UBound(sArr, 2)
    dU1 = WorksheetFunction.Sum(WorksheetFunction.Index(sArr, 0, 4))
    dU2 = 3
End With
ReDim dArr(1 To dU1, 1 To dU2)
For I = 1 To sU1
    For J = 1 To sArr(I, 4)
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
    Next
Next
With Sheets("result")
    If K Then
        .Range("E2").Resize(Rows.Count - 10, 3).ClearContents
        .Range("E2").Resize(K, dU2) = dArr
    End If
End With
End Sub
 

File đính kèm

  • TachDuLieu.xlsm
    19.8 KB · Đọc: 11
Anh/chị cho em hỏi mình có cách nào tách dữ liệu thành nhiều dòng dựa theo điều kiện.
Vd: E có 1 bảng "data" vào như file đính kèm, tương ứng điều kiện của "number_subject", sẽ hiển thị kết quả tương ứng như sheet "result".
Dùng thử code này xem sao.
Mã:
Sub ABC()
Dim i&, j&, t&, k&, tong&, lr&
Dim Arr(), KQ()
With Sheets("data")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A1:D" & lr).Value
tong = Application.Sum(.Range("D2:D" & lr))
End With
ReDim KQ(1 To tong + 1, 1 To 3)
k = 1
KQ(k, 1) = Arr(1, 1)
KQ(k, 2) = Arr(1, 2)
KQ(k, 3) = Arr(1, 3)
For i = 2 To UBound(Arr)
    If IsNumeric(Arr(i, 4)) Then t = Arr(i, 4)
        For j = 1 To t
            k = k + 1
            KQ(k, 1) = Arr(i, 1)
            KQ(k, 2) = Arr(i, 2)
            KQ(k, 3) = Arr(i, 3)
        Next j
Next i
If k Then
Sheets("result").[A1].Resize(k, 3).ClearContents
Sheets("result").[A1].Resize(k, 3) = KQ
End If
MsgBox "Xong"
End Sub
[\Code]
 

File đính kèm

  • Phan tich thanh nhieu dong(cua Dahoydu).xlsm
    16.6 KB · Đọc: 11
Dùng thử code này xem sao.
Mã:
Sub ABC()
Dim i&, j&, t&, k&, tong&, lr&
Dim Arr(), KQ()
With Sheets("data")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A1:D" & lr).Value
tong = Application.Sum(.Range("D2:D" & lr))
End With
ReDim KQ(1 To tong + 1, 1 To 3)
k = 1
KQ(k, 1) = Arr(1, 1)
KQ(k, 2) = Arr(1, 2)
KQ(k, 3) = Arr(1, 3)
For i = 2 To UBound(Arr)
    If IsNumeric(Arr(i, 4)) Then t = Arr(i, 4)
        For j = 1 To t
            k = k + 1
            KQ(k, 1) = Arr(i, 1)
            KQ(k, 2) = Arr(i, 2)
            KQ(k, 3) = Arr(i, 3)
        Next j
Next i
If k Then
Sheets("result").[A1].Resize(k, 3).ClearContents
Sheets("result").[A1].Resize(k, 3) = KQ
End If
MsgBox "Xong"
End Sub
[\Code]
Cho phép mình góp ý với code bạn tí nhé,
1/ Mình có thể cho arr(1,4)=1 từ đầu luôn thì đỡ phải ghi KQ nhiều lần
2/ Chỗ resize(k,3).clearcontents đó chưa hợp lý. Nếu dữ liệu ban đầu dài hơn, xóa như vậy vẫn sót dữ liệu cũ
Code mình sửa chút nó như này:
Mã:
Sub ABC()
Dim i&, j&, t&, k&, tong&, lr&
Dim Arr(), KQ()
With Sheets("data")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A1:D" & lr).Value
Arr(1, 4) = 1
tong = Application.Sum(.Range("D2:D" & lr))
End With
ReDim KQ(1 To tong + 1, 1 To 3)
For i = 1 To UBound(Arr)
    If IsNumeric(Arr(i, 4)) Then t = Arr(i, 4)
        For j = 1 To t
            k = k + 1
            KQ(k, 1) = Arr(i, 1)
            KQ(k, 2) = Arr(i, 2)
            KQ(k, 3) = Arr(i, 3)
        Next j
Next i
If k Then
Sheets("result").[A1].Resize(Rows.Count, 3).ClearContents
Sheets("result").[A1].Resize(k, 3) = KQ
End If
MsgBox "Xong"
End Sub
 
Anh/chị cho em hỏi mình có cách nào tách dữ liệu thành nhiều dòng dựa theo điều kiện.
Vd: E có 1 bảng "data" vào như file đính kèm, tương ứng điều kiện của "number_subject", sẽ hiển thị kết quả tương ứng như sheet "result".
Bạn tham khảo với cách dùng công thức.
 

File đính kèm

  • Book1 (1.2).xlsx
    11.1 KB · Đọc: 12
Cho phép mình góp ý với code bạn tí nhé,
1/ Mình có thể cho arr(1,4)=1 từ đầu luôn thì đỡ phải ghi KQ nhiều lần
2/ Chỗ resize(k,3).clearcontents đó chưa hợp lý. Nếu dữ liệu ban đầu dài hơn, xóa như vậy vẫn sót dữ liệu cũ
Code mình sửa chút nó như này:
Mã:
Sub ABC()
Dim i&, j&, t&, k&, tong&, lr&
Dim Arr(), KQ()
With Sheets("data")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A1:D" & lr).Value
Arr(1, 4) = 1
tong = Application.Sum(.Range("D2:D" & lr))
End With
ReDim KQ(1 To tong + 1, 1 To 3)
For i = 1 To UBound(Arr)
    If IsNumeric(Arr(i, 4)) Then t = Arr(i, 4)
        For j = 1 To t
            k = k + 1
            KQ(k, 1) = Arr(i, 1)
            KQ(k, 2) = Arr(i, 2)
            KQ(k, 3) = Arr(i, 3)
        Next j
Next i
If k Then
Sheets("result").[A1].Resize(Rows.Count, 3).ClearContents
Sheets("result").[A1].Resize(k, 3) = KQ
End If
MsgBox "Xong"
End Sub
Cảm ơn anh đã xem bài và chỉ giáo.
1/ anh thay Arr(i,4)=1 đã rút gọn được code rất nhiều: không phải k=0; không phải ghi dòng tiêu đề.
2/ Tôi chỉ nghĩ là xóa dũ liệu cũ qua mỗi lần chay code chứ chưa nghĩ đến xóa toàn bộ dữ liệu cột A:C để gán kết quả vào.
Thật đúng là tầm chuyên gia VBA có khác. Anh đã cho tôi và nhiều bạn mới học VBA một kinh nghiệm quý báu.
 
Cảm ơn anh đã xem bài và chỉ giáo.
1/ anh thay Arr(i,4)=1 đã rút gọn được code rất nhiều: không phải k=0; không phải ghi dòng tiêu đề.
2/ Tôi chỉ nghĩ là xóa dũ liệu cũ qua mỗi lần chay code chứ chưa nghĩ đến xóa toàn bộ dữ liệu cột A:C để gán kết quả vào.
Thật đúng là tầm chuyên gia VBA có khác. Anh đã cho tôi và nhiều bạn mới học VBA một kinh nghiệm quý báu.
Chời gì khen nức mũi vậy, thật ra mình cũng không khá khẩm gì đâu. Lâu lâu kiểu mèo mù vớ cá rán vậy thôi :D
 
Anh/chị cho em hỏi mình có cách nào tách dữ liệu thành nhiều dòng dựa theo điều kiện.
Vd: E có 1 bảng "data" vào như file đính kèm, tương ứng điều kiện của "number_subject", sẽ hiển thị kết quả tương ứng như sheet "result".
Thêm một cách khác cho bạn.
 

File đính kèm

  • Tach_Dong.xlsm
    20.2 KB · Đọc: 14
Cám ơn cả nhà nhiều, ko ngờ nhận được nhiều cách khác nhau từ nhiều anh/chị như vậy :)
 
Web KT
Back
Top Bottom