Lọc, sắp xếp và điền dữ liệu có điều kiện.

[sangucu1]

Em xin lỗi cả nhà về bài đăng trước đã để toàn chữ in hoa.

Nay em xin đăng bài khác do không biết cách sửa lại thành chữ thường ở bài kia như nào.

Các anh cho em xin hàm hoặc code bài toán này với ạ (em xin phép đính kèm file và điền bằng tay chỗ bôi mầu làm 1 ví dụ):

Nội dung bài toán:

- Lấy dữ liệu từ cột A (dạng tổ hợp) tran sang cột H (dạng đơn)
- Lấy dữ liệu từ cột E tran thành hàng về 2 cột I và J (lấy các cột A,B,E,F và chính cột H làm điều kiện)

- Tổ hợp ở cột A có thể bao gồm 1, 2, 3 hoặc 4 mã có 4 ký tự, phân biệt nhau bởi dấu " , " (mã nằm trong khoảng từ B001 đến ZZ99).
- Thứ tự từ trên xuống dưới ở cột H là: Từ B001 đến ZZ99

Kính mong các anh giúp đỡ em ạ.

Em trân trọng cảm ơn.

 

[HieuCD]

Em xin lỗi cả nhà về bài đăng trước đã để toàn chữ in hoa.

Nay em xin đăng bài khác do không biết cách sửa lại thành chữ thường ở bài kia như nào.

Các anh cho em xin hàm hoặc code bài toán này với ạ (em xin phép đính kèm file và điền bằng tay chỗ bôi mầu làm 1 ví dụ):

Nội dung bài toán:

- Lấy dữ liệu từ cột A (dạng tổ hợp) tran sang cột H (dạng đơn)
- Lấy dữ liệu từ cột E tran thành hàng về 2 cột I và J (lấy các cột A,B,E,F và chính cột H làm điều kiện)

- Tổ hợp ở cột A có thể bao gồm 1, 2, 3 hoặc 4 mã có 4 ký tự, phân biệt nhau bởi dấu " , " (mã nằm trong khoảng từ B001 đến ZZ99).
- Thứ tự từ trên xuống dưới ở cột H là: Từ B001 đến ZZ99

Kính mong các anh giúp đỡ em ạ.

Em trân trọng cảm ơn.

Code viết theo đặc điểm dữ liệu của file, kiểm tra lại

Sub ABC()
  Dim arr(), S, res(), sRow&, sR&, i&, j&, k&, N&
  With Sheets("Sheet1")
    i = .Range("F" & Rows.Count).End(xlUp).Row
    .Rows("2:10000").EntireRow.Hidden = False
    arr = .Range("A2", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  For i = 1 To sRow Step 3
    sR = sR + Int((Len(arr(i, 1)) + 1) / 5)
  Next i
  ReDim res(1 To sR, 1 To 3)
  For i = 2 To sRow Step 3
    If arr(i, 1) <> Empty Then
      S = Split(arr(i, 1), ",")
      N = UBound(S)
      For j = 0 To N
        k = k + 1
        res(k, 1) = S(j)
        res(k, 2) = arr(i, 5)
        res(k, 3) = arr(i + 1, 5)
      Next j
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("H" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("H2:J" & i).ClearContents
    .Range("H2").Resize(k, 3) = res
    .Range("H2").Resize(k, 3).Sort .Range("H2"), 1, Header:=xlNo
  End With
End Sub

 

[sangucu1]

Code viết theo đặc điểm dữ liệu của file, kiểm tra lại

Sub ABC()
  Dim arr(), S, res(), sRow&, sR&, i&, j&, k&, N&
  With Sheets("Sheet1")
    i = .Range("F" & Rows.Count).End(xlUp).Row
    .Rows("2:10000").EntireRow.Hidden = False
    arr = .Range("A2", .Range("F" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  For i = 1 To sRow Step 3
    sR = sR + Int((Len(arr(i, 1)) + 1) / 5)
  Next i
  ReDim res(1 To sR, 1 To 3)
  For i = 2 To sRow Step 3
    If arr(i, 1) <> Empty Then
      S = Split(arr(i, 1), ",")
      N = UBound(S)
      For j = 0 To N
        k = k + 1
        res(k, 1) = S(j)
        res(k, 2) = arr(i, 5)
        res(k, 3) = arr(i + 1, 5)
      Next j
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("H" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("H2:J" & i).ClearContents
    .Range("H2").Resize(k, 3) = res
    .Range("H2").Resize(k, 3).Sort .Range("H2"), 1, Header:=xlNo
  End With
End Sub

Kết quả thật tuyệt vời.
Em cảm ơn anh rất nhiều. Chúc anh và gia đình ăn tết vui vẻ.
Chúc anh chị em trong diễn đàn một mùa xuân mới ấm no và hạnh phúc.