Tách dữ liệu trong một ô thành nhiều dòng

[pqkythuat1]

Chào các bạn,

Rất mong các bạn giúp mình cách để chia nhỏ dữ liệu của 1 ô thành nhiều dòng như trong hình. Cám ơn các bạn rất nhiều.

 

[VetMini]

Đã không rành VBA, nhờ ngươi ta viết code giùm mà lại chọn ngay cái kết quả thuộc loại về sau này muốn làm gì nữa lại phải nhờ viết code..
Muốn nói chuyện VBA thì phải bỏ đi cái ý tưởng merged cells hoặc cách ghi dữ liệu vào một ô rồi "tự nghiệm" ra các dòng còn lại.

Nếu không, muốn làm gì ở bảng KQ lại phải lên đây nhờ trợ giúp.
Bất cứ cái sông thức nào trên bảng KQ đều có khả năng là công thức khủng.

 

[HieuCD]

Chào các bạn,

Rất mong các bạn giúp mình cách để chia nhỏ dữ liệu của 1 ô thành nhiều dòng như trong hình. Cám ơn các bạn rất nhiều.
View attachment 285776

Chạy sub . . . .

Sub ABC()
  Dim arr(), S, res(), ch10$
  Dim sRow&, sCol&, i&, j&, r&, k&, eR&, maxR&
  Const srRes& = 9999 'gioi han so dong ket qua: 9999
 
  ch10 = Chr(10)
  ReDim res(1 To srRes, 1 To 5)
  With Sheets("DATA")
    arr = .Range("A1", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr): sCol = UBound(arr, 2)
  On Error Resume Next
  For i = 1 To sRow
    maxR = 0
    For j = 1 To sCol
      k = eR
      S = Split(ch10 & arr(i, j), ch10)
      For r = 1 To UBound(S)
        k = k + 1
        res(k, j) = S(r)
      Next r
      If maxR < k Then maxR = k
    Next j
    eR = maxR
  Next i
  If Err.Number > 0 Then
    MsgBox ("So dong ket qua khai bao thieu !" & ch10 & "Khai bao lai: Const srRes& = ??????")
    Exit Sub
  End If
  With Sheets("KETQUA")
    If .Range("A1").Value <> Empty Then .Range("A1").CurrentRegion.ClearContents
    .Range("A1").Resize(eR, 5) = res
  End With
End Sub

 

[pqkythuat1]

Cám ơn hai bạn @VetMini và @HieuCD đã hỗ trợ. Thật tình mình cũng là người nhận việc từ trên giao xuống chứ nhìn bảng dữ liệu mà có merge cell là mình muốn trốn như rắn trốn mùng năm. Mình cũng đã góp ý với các sếp về vấn đề tổ chức dữ liệu của bảng excel sao cho thuận tiện hơn.

 

[VetMini]

Cám ơn hai bạn @VetMini và @HieuCD đã hỗ trợ. Thật tình mình cũng là người nhận việc từ trên giao xuống chứ nhìn bảng dữ liệu mà có merge cell là mình muốn trốn như rắn trốn mùng năm. Mình cũng đã góp ý với các sếp về vấn đề tổ chức dữ liệu của bảng excel sao cho thuận tiện hơn.

Góp ý suông rất hiếm khi thành công.
Vấn đề này chỉ có bạn giải quyết được cho mình.
Lúc góp ý hay đề nghị, bạn phải hoàn toàn tự tin vào khả năng của mình.

Và cách duy nhất để bạn có thể hoàn toàn tự tin là cố học để bổ sung kiễn thức.
- Ở mọt trình độ nào đó, bạn sẽ không lúng túng khi người ta hạch ngwocj lại mình.
- Ở một mức hiểu biết về công việc quản lý nào đó, bạn sẽ hiểu làm cách nào cho người ta tin mình.
- Ở một mức hiểu biết về chung quanh nào đó, bạn sẽ có cách khuyên bảo người ta mà không gây mỏi lo sợ cho người ta - nhiều người chống cải tổ do nổi sợ bị coi là tụt hậu.

Tất cả 3 nổ lực trên đều có lợi cho tiền đồ của bạn. Không làm được là do bạn không cố gắng.

 

[Phương Phương mito]

Chạy sub . . . .

Sub ABC()
  Dim arr(), S, res(), ch10$
  Dim sRow&, sCol&, i&, j&, r&, k&, eR&, maxR&
  Const srRes& = 9999 'gioi han so dong ket qua: 9999
 
  ch10 = Chr(10)
  ReDim res(1 To srRes, 1 To 5)
  With Sheets("DATA")
    arr = .Range("A1", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr): sCol = UBound(arr, 2)
  On Error Resume Next
  For i = 1 To sRow
    maxR = 0
    For j = 1 To sCol
      k = eR
      S = Split(ch10 & arr(i, j), ch10)
      For r = 1 To UBound(S)
        k = k + 1
        res(k, j) = S(r)
      Next r
      If maxR < k Then maxR = k
    Next j
    eR = maxR
  Next i
  If Err.Number > 0 Then
    MsgBox ("So dong ket qua khai bao thieu !" & ch10 & "Khai bao lai: Const srRes& = ??????")
    Exit Sub
  End If
  With Sheets("KETQUA")
    If .Range("A1").Value <> Empty Then .Range("A1").CurrentRegion.ClearContents
    .Range("A1").Resize(eR, 5) = res
  End With
End Sub

Nhân xem code anh Hiếu trường hợp của bạn này hỏi. Thế em cũng hay phải làm ngược lại là gom vào một ô như File này thì code sao ạ. Mong anh Hiếu giúp ạ.

 

[Thóc Sama]

Nhân xem code anh Hiếu trường hợp của bạn này hỏi. Thế em cũng hay phải làm ngược lại là gom vào một ô như File này thì code sao ạ. Mong anh Hiếu giúp ạ.

Bạn thử chạy code cùi này rồi kiểm tra kết quả xem được không nha!
(Xin lỗi anh @HieuCD vì em đang hơi rãnh )

Option Explicit
Sub GPE()
    Dim Arr(), Res(), i&, Lr&
    Dim Dic As Object, a&
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A2:B" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 2)
        For i = 1 To UBound(Arr)
            If Not Dic.exists(Arr(i, 1)) Then
                a = a + 1
                Dic.Add (Arr(i, 1)), a
                Res(a, 1) = Arr(i, 1)
                Res(a, 2) = Arr(i, 2)
            Else
                Res(Dic.Item(Arr(i, 1)), 2) = Res(Dic.Item(Arr(i, 1)), 2) & Chr(10) & Arr(i, 2)
            End If
        Next i
        If a Then
            .Range("G2:H100000").ClearContents
            .Range("G2").Resize(a, 2).Value = Res
        End If
    End With
    Set Dic = Nothing
End Sub

 

[HieuCD]

Nhân xem code anh Hiếu trường hợp của bạn này hỏi. Thế em cũng hay phải làm ngược lại là gom vào một ô như File này thì code sao ạ. Mong anh Hiếu giúp ạ.

Cột A đã sort ?
Cột B có khả năng trùng ? Ví dụ các dòng có giá trị "A", các giá trị ở cột B có trùng nhau không?

 

[VetMini]

Tách ra và gộp lại, trên nguyên tắc là lô gic ngược nhau. Chỉ cần chuyên lô gic ngược lại là xong.

Đối với lý thuyết lập trình thì đúng, và có nhiều ngôn ngữ cho phép làm việc này
Rất tiếc, VBA nó có cái ký tự A là application, và nó không theo lý thuyết ấy. Bởi vì trong nền tảng VBA cho Excel có những Objects giúp cho làm việc hiệu quả hơn cho mỗi trường hợp đặc thù.

Vì vậy câu hỏi này đngs lẽ khong thể làm câu ohuj cửa chủ đề, cần hỏi riêng trong đề bài khác.

Tuuy nhiên, tôi cũng hé mọt phần, cho thấy những điểm chảng phải làm ngược với giải thuật trên.

1. Giải thuật còn tùy theo bảng gôc đã sắp xếp chưa (xem câu hỏi bải #8)
-- Nếu xếp ròi thì chỉ việc lập mảng đầu vào và mảng đầu ra.
-- Nếu chưa sắp xếp thì phải có giải thuật gom, ở GPE này, người ta hay dùng Dictionary để thực hiện công việc gom.
2. Lúc gom nhiều dữ liệu về một chuỗi thì thwowngf dùng phương pháp nối chuỗi tạm, sau đó lọc lại chuỗi để loại bỏ các dâu nối thừa. Có hai kỹ thuật để làm việc này:
2.1. Dủng hàm replace cho đến khi hết thừa.
2.2. Dùng hàm split để tách ra từng phần. Kế đó:
--- Dùng hàm Filter để lược bỏ những phần tử trống
--- Dung hàm join để nối lại.