Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện (5 người xem)

[Manhhung90]

Mình có 1 file excel cần chuyển dữ liệu từ cột sang hàng theo các điều kiện như file em gởi ạ. Nhờ mọi người giúp đỡ em ạ. Em cảm ơn!!

 

[Hoàng Tuấn 868]

chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện​

Mình có 1 file excel cần chuyển dữ liệu từ cột sang hàng theo các điều kiện như file em gởi ạ. Nhờ mọi người giúp đỡ em ạ. Em cảm ơn!!

Hình như gửi nhầm file thì phải. Đây vẫn là cột sang cột.

 

[Manhhung90]

chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện​

Hình như gửi nhầm file thì phải. Đây vẫn là cột sang cột.
View attachment 306436

Mình xin lỗi vì gởi nhầm mà hôm nay bận công việc nên không lên để chỉnh sửa lại được ạ. Mình gởi lại file ạ. Nhờ mọi người giúp ạ

 

[HUONGHCKT]

Mình xin lỗi vì gởi nhầm mà hôm nay bận công việc nên không lên để chỉnh sửa lại được ạ. Mình gởi lại file ạ. Nhờ mọi người giúp ạ

Trong khi chờ đợi các code sịn hơn. hãy thử tham khảo code trong file đính kèm.

 

[Manhhung90]

Trong khi chờ đợi các code sịn hơn. hãy thử tham khảo code trong file đính kèm.

Cảm ơn bạn nhiều ạ!!

 

[SteveNguyen1991]

Một cách khác dùng Power Query.

 

[Manhhung90]

Trong khi chờ đợi các code sịn hơn. hãy thử tham khảo code trong file đính kèm.

Mình mới test code thì có vấn đề sau nhờ bạn giúp ạ:
+ ô có số thứ tự thì mới điền vào ạ, ô không có số thứ tự nhưng có dữ liệu ở ô B hoặc C thì vẫn không điền, hiện tại code đang là có chữ ở ô thì vẫn điền ạ.
+ Số thứ tự nếu tăng dần theo số nguyên ví dụ 1,2,3... Thì điền dữ liệu tương ứng từ cột B vào. Nếu số thứ tự mà 1, 1.1, 1.2... thì chỉ điền 1.1, 1.2 và dữ liệu tương ứng cột C vào chứ không lấy dữ liệu ở ô 1.

 

[HUONGHCKT]

Mình mới test code thì có vấn đề sau nhờ bạn giúp ạ:
+ ô có số thứ tự thì mới điền vào ạ, ô không có số thứ tự nhưng có dữ liệu ở ô B hoặc C thì vẫn không điền, hiện tại code đang là có chữ ở ô thì vẫn điền ạ.
+ Số thứ tự nếu tăng dần theo số nguyên ví dụ 1,2,3... Thì điền dữ liệu tương ứng từ cột B vào. Nếu số thứ tự mà 1, 1.1, 1.2... thì chỉ điền 1.1, 1.2 và dữ liệu tương ứng cột C vào chứ không lấy dữ liệu ở ô 1.

Trước hết hỏi bạn là kết quả có đúng như file demo không?mà giờ lại "...Mình mới test code thì có vấn đề sau..."
Nếu muốn kết quả thế nào thì phải mô tả thật kỹ.
Tôi là người không được tinh anh như người ta nên muốn hỏi bạn thêm là.
"...có chữ ở ô...", xin hỏi là có chữ ở ô thì là ô nào vậy?Phải chăng là Ô ở cột B hoặc cột C.
"...dữ liệu ở ô 1.." Ô 1 là ô nào vậy? Phải chăng là ô ở cột B?
nếu đúng thì bạn cũng là người biết đùa đấy. Tung chiêu cho người khác làm thầy bói đoán mò.
Xem code

Option Explicit

Sub ManhHung90()
Dim i&, j&, Lr&, t&, k&
Dim Arr(), KQ()
Dim A As Boolean, Ten$
With Sheet1
Lr = .Range("A100000").End(xlUp).Row
Arr = .Range("A2:C" & Lr).Value
ReDim KQ(1 To 2, 1 To UBound(Arr) * 3)
For i = 1 To UBound(Arr)
    A = False
    If Arr(i, 1) <> Empty Then
        If Int(Arr(i, 1)) = Arr(i, 1) Then
            If Arr(i, 2) <> Empty Then Ten = Arr(i, 2): A = True
        Else
            If Arr(i, 3) <> Empty Then Ten = Arr(i, 3): A = True
        End If
    End If
        If A = True Then
            t = t + 1: k = (t - 1) * 2 + 1
             KQ(1, k) = Arr(i, 1)
             KQ(2, k) = Ten
             KQ(2, k + 1) = .Range("D1")
        End If
    
Next i
.Range("E1").Resize(2, 1000).ClearContents
.Range("E1").Resize(2, k) = KQ
End With
MsgBox "Done"
End Sub

làm theo hướng đoán mò
Thay code cũ bằng code này;

 

[Manhhung90]

Trước hết hỏi bạn là kết quả có đúng như file demo không?mà giờ lại "...Mình mới test code thì có vấn đề sau..."
Nếu muốn kết quả thế nào thì phải mô tả thật kỹ.
Tôi là người không được tinh anh như người ta nên muốn hỏi bạn thêm là.
"...có chữ ở ô...", xin hỏi là có chữ ở ô thì là ô nào vậy?Phải chăng là Ô ở cột B hoặc cột C.
"...dữ liệu ở ô 1.." Ô 1 là ô nào vậy? Phải chăng là ô ở cột B?
nếu đúng thì bạn cũng là người biết đùa đấy. Tung chiêu cho người khác làm thầy bói đoán mò.
Xem code

Option Explicit

Sub ManhHung90()
Dim i&, j&, Lr&, t&, k&
Dim Arr(), KQ()
Dim A As Boolean, Ten$
With Sheet1
Lr = .Range("A100000").End(xlUp).Row
Arr = .Range("A2:C" & Lr).Value
ReDim KQ(1 To 2, 1 To UBound(Arr) * 3)
For i = 1 To UBound(Arr)
    A = False
    If Arr(i, 1) <> Empty Then
        If Int(Arr(i, 1)) = Arr(i, 1) Then
            If Arr(i, 2) <> Empty Then Ten = Arr(i, 2): A = True
        Else
            If Arr(i, 3) <> Empty Then Ten = Arr(i, 3): A = True
        End If
    End If
        If A = True Then
            t = t + 1: k = (t - 1) * 2 + 1
             KQ(1, k) = Arr(i, 1)
             KQ(2, k) = Ten
             KQ(2, k + 1) = .Range("D1")
        End If
 
Next i
.Range("E1").Resize(2, 1000).ClearContents
.Range("E1").Resize(2, k) = KQ
End With
MsgBox "Done"
End Sub

làm theo hướng đoán mò
Thay code cũ bằng code này;

Xin lỗi do mình diễn đạt không tốt. Dữ liệu ở ô 1 như sau ạ:

 

[HieuCD]

Mình xin lỗi vì gởi nhầm mà hôm nay bận công việc nên không lên để chỉnh sửa lại được ạ. Mình gởi lại file ạ. Nhờ mọi người giúp ạ

Kiểm tra lại . .

Sub abc()
  Dim arr(), res(), sh As Worksheet
  Dim sRow&, i&, j&, c&
 
  Set sh = Sheets("Sheet1")
  arr = sh.Range("A2:C" & sh.Range("A100000").End(xlUp).Row + 1).Value
  sRow = UBound(arr) - 1
  ReDim res(1 To 2, 1 To sRow * 2)
  For i = 1 To sRow
    If arr(i, 1) <> Empty Then
      If Not (arr(i + 1, 1) & "." Like arr(i, 1) & ".*") Then
        If InStr(1, ".", arr(i, 2)) Then j = 3 Else j = 2
        c = c + 2
        res(1, c - 1) = arr(i, 1)
        res(2, c - 1) = arr(i, j)
        res(2, c) = "Lop"
      End If
    End If
  Next i
  sh.Range("E1").Resize(2, 1000).Clear
  sh.Range("E1").Resize(2, c) = res
  sh.Range("E1").Resize(2, c).Borders.LineStyle = 1
End Sub

 

[Manhhung90]

Kiểm tra lại . .

Sub abc()
  Dim arr(), res(), sh As Worksheet
  Dim sRow&, i&, j&, c&
 
  Set sh = Sheets("Sheet1")
  arr = sh.Range("A2:C" & sh.Range("A100000").End(xlUp).Row + 1).Value
  sRow = UBound(arr) - 1
  ReDim res(1 To 2, 1 To sRow * 2)
  For i = 1 To sRow
    If arr(i, 1) <> Empty Then
      If Not (arr(i + 1, 1) & "." Like arr(i, 1) & ".*") Then
        If InStr(1, ".", arr(i, 2)) Then j = 3 Else j = 2
        c = c + 2
        res(1, c - 1) = arr(i, 1)
        res(2, c - 1) = arr(i, j)
        res(2, c) = "Lop"
      End If
    End If
  Next i
  sh.Range("E1").Resize(2, 1000).Clear
  sh.Range("E1").Resize(2, c) = res
  sh.Range("E1").Resize(2, c).Borders.LineStyle = 1
End Sub

Quá chuẩn ạ. Cảm ơn anh đã hỗ trợ giúp em. Cảm ơn anh nhiều!!!