Chuyển dữ liệu từ cột dọc sang hàng ngang

[cuonggps]

Em chào các bác. Em không hiểu biết quá nhiều về excel và có một file excel mong muốn các bác giúp em xử lý với. Em có dữ liệu ở cột A và cột B, sau khi lọc trùng lặp thì nó ra cái file như em đính kèm. Các giá trị ở cột A tương ứng với giá trị ở cột B, mà giờ cột A có các dữ liệu giống nhau.
Em muốn chuyển từ cột dọc sang hàng ngang như file đính kèm.
Chỉ lấy giá trị giống nhau duy nhất ở cột A và các giá trị tương ứng ở cột B chuyển sang hàng ngang.
Em nói có vẻ hơi khó hiểu. Các bác xem file rồi giúp em với ạ.
Mong phản hồi sớm của các bác ạ. Em cảm ơn trước ạ.

 

[HieuCD]

Em chào các bác. Em không hiểu biết quá nhiều về excel và có một file excel mong muốn các bác giúp em xử lý với. Em có dữ liệu ở cột A và cột B, sau khi lọc trùng lặp thì nó ra cái file như em đính kèm. Các giá trị ở cột A tương ứng với giá trị ở cột B, mà giờ cột A có các dữ liệu giống nhau.
Em muốn chuyển từ cột dọc sang hàng ngang như file đính kèm.
Chỉ lấy giá trị giống nhau duy nhất ở cột A và các giá trị tương ứng ở cột B chuyển sang hàng ngang.
Em nói có vẻ hơi khó hiểu. Các bác xem file rồi giúp em với ạ.
Mong phản hồi sớm của các bác ạ. Em cảm ơn trước ạ.

D1 =A1

D2 =IFERROR(INDEX($A$1:$A$350,LOOKUP(2,1/($A$1:$A$350=D1),ROW($2:$350))),"")

Copy xuống

E1 =IF(COLUMN(A1)<=COUNTIF($A$1:$A$350,$D1),INDEX($B$1:$B$350,MATCH($D1,$A$1:$A$350,0)+COLUMN(A1)-1),"")

Copy cho các ô còn lại

 

[cuonggps]

D1 =A1

D2 =IFERROR(INDEX($A$1:$A$350,LOOKUP(2,1/($A$1:$A$350=D1),ROW($2:$350))),"")

Copy xuống

E1 =IF(COLUMN(A1)<=COUNTIF($A$1:$A$350,$D1),INDEX($B$1:$B$350,MATCH($D1,$A$1:$A$350,0)+COLUMN(A1)-1),"")

Copy cho các ô còn lại

dạ em cảm ơn bác rất nhiều ạ <3

 

[cuonggps]

D1 =A1

D2 =IFERROR(INDEX($A$1:$A$350,LOOKUP(2,1/($A$1:$A$350=D1),ROW($2:$350))),"")

Copy xuống

E1 =IF(COLUMN(A1)<=COUNTIF($A$1:$A$350,$D1),INDEX($B$1:$B$350,MATCH($D1,$A$1:$A$350,0)+COLUMN(A1)-1),"")

Copy cho các ô còn lại

 

[cuonggps]

D1 =A1

D2 =IFERROR(INDEX($A$1:$A$350,LOOKUP(2,1/($A$1:$A$350=D1),ROW($2:$350))),"")

Copy xuống

E1 =IF(COLUMN(A1)<=COUNTIF($A$1:$A$350,$D1),INDEX($B$1:$B$350,MATCH($D1,$A$1:$A$350,0)+COLUMN(A1)-1),"")

Copy cho các ô còn lại

Alo bác ơi, em làm mà dữ liệu nhiều nó vẫn không hết. Dữ liệu cột A của em lên đến 10k, nhưng nó chỉ kéo được đến 200 điểm trùng lặp. Em có kiểm tra lại thì thấy chưa hết. Mà làm 10k dữ liệu ở cột A như thế máy nó cũng lag, mà làm ít thì lại phải làm nhiều lần. Bác giúp em làm 3k dữ liệu 1 lần với ạ.
Bác xem chỉnh sửa giúp em với ạ.

 

[HieuCD]

Alo bác ơi, em làm mà dữ liệu nhiều nó vẫn không hết. Dữ liệu cột A của em lên đến 10k, nhưng nó chỉ kéo được đến 200 điểm trùng lặp. Em có kiểm tra lại thì thấy chưa hết. Mà làm 10k dữ liệu ở cột A như thế máy nó cũng lag, mà làm ít thì lại phải làm nhiều lần. Bác giúp em làm 3k dữ liệu 1 lần với ạ.
Bác xem chỉnh sửa giúp em với ạ.

Dữ liệu nhiều nên dùng macro VBA

 

[TongDe]

Click tuần tự từng nút,
quan sát và kiểm tra lại coi đã dúng yêu cầu chưa...

 

[cuonggps]

Dữ liệu nhiều nên dùng macro VBA

dùng như nào ạ bác, giúp em với ạ

Bài đã được tự động gộp: 19/7/23

Click tuần tự từng nút,
quan sát và kiểm tra lại coi đã dúng yêu cầu chưa...

Không được bác ạ. Bác xem giúp em với.

 

[HieuCD]

dùng như nào ạ bác, giúp em với ạ

Bài đã được tự động gộp: 19/7/23

Không được bác ạ. Bác xem giúp em với.

bấm mũi tên chạy code

Sub XYZ()
  Dim arr(), res()
  Dim sRow&, sr&, i&, j&, k&, ma
 
  With Sheets("Sheet1") '"Sheet1" là ten sheet chua du lieu
    arr = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  sr = sRow / 5 'So dong ket qua. Neu Code bi loi, chinh so 5 thành 4, 3 ,2
  ReDim res(1 To sr, 1 To 20)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      j = 2
      res(k, 1) = ma
      res(k, j) = arr(i, 2)
    Else
      j = j + 1
      If j > UBound(res, 2) Then ReDim Preserve res(1 To sr, 1 To UBound(res, 2) + 20)
      res(k, j) = arr(i, 2)
    End If
  Next i
  With Sheets("Sheet1") '"Sheet1" là ten sheet ket qua
    .Range("D1").Resize(k, UBound(res, 2)).NumberFormat = "#"
    .Range("D1").Resize(k, UBound(res, 2)) = res
  End With
End Sub

 

[cuonggps]

bấm mũi tên chạy code

Sub XYZ()
  Dim arr(), res()
  Dim sRow&, sr&, i&, j&, k&, ma
 
  With Sheets("Sheet1") '"Sheet1" là ten sheet chua du lieu
    arr = .Range("A1", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  sr = sRow / 5 'So dong ket qua. Neu Code bi loi, chinh so 5 thành 4, 3 ,2
  ReDim res(1 To sr, 1 To 20)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      j = 2
      res(k, 1) = ma
      res(k, j) = arr(i, 2)
    Else
      j = j + 1
      If j > UBound(res, 2) Then ReDim Preserve res(1 To sr, 1 To UBound(res, 2) + 20)
      res(k, j) = arr(i, 2)
    End If
  Next i
  With Sheets("Sheet1") '"Sheet1" là ten sheet ket qua
    .Range("D1").Resize(k, UBound(res, 2)).NumberFormat = "#"
    .Range("D1").Resize(k, UBound(res, 2)) = res
  End With
End Sub

Em thay bằng dữ liệu khác và bấm mũi tên nó báo lỗi bác ạ. Bác xem lại em với.

 

[DAOHUYENNEU]

Em có file dữ liệu có chung nhu cầu xử lý dữ liệu như chủ top ạ, nhưng số lượng cột cần xử lý nhiều hơn, chi tiết em đính kèm file
đây chỉ là file mẫu, dữ liệu em cần xử lý rất lớn, nên các bác hướng dẫn thêm trong trường hợp thêm số lượng dòng ở sheet data và tăng số lượng cột ở sheet bài toán ạ
Nhờ các bác cao thủ giúp đỡ em với ạ, em cảm ơn nhiều

 

[HieuCD]

Em thay bằng dữ liệu khác và bấm mũi tên nó báo lỗi bác ạ. Bác xem lại em với.

Chỉnh sr = sRow / 5 thành sr = sRow

 

[HieuCD]

Em có file dữ liệu có chung nhu cầu xử lý dữ liệu như chủ top ạ, nhưng số lượng cột cần xử lý nhiều hơn, chi tiết em đính kèm file
đây chỉ là file mẫu, dữ liệu em cần xử lý rất lớn, nên các bác hướng dẫn thêm trong trường hợp thêm số lượng dòng ở sheet data và tăng số lượng cột ở sheet bài toán ạ
Nhờ các bác cao thủ giúp đỡ em với ạ, em cảm ơn nhiều

Chạy code . . .

Sub XYZ()
  Dim arr(), res()
  Dim sRow&, i&, j&, c&, k&, ma
 
  With Sheets("Data") '"Data" là ten sheet chua du lieu
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 4 + 9 * 3)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      For j = 1 To 4
        If c < 6 Then c = j Else c = c + 9
        res(k, j) = arr(i, j)
      Next j
    End If
    res(k, j) = arr(i, 5)
    res(k, j + 9) = arr(i, 6)
    res(k, j + 18) = arr(i, 7)
    j = j + 1
  Next i
  With Sheet4 'sheet ket qua
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:AE" & i).Clear
    .Range("A2").Resize(k, 4).NumberFormat = "@"
    .Range("A2").Resize(k, UBound(res, 2)) = res
    .Range("A2").Resize(k, UBound(res, 2)).Borders.LineStyle = 1
  End With
End Sub

 

[DAOHUYENNEU]

Chạy code . . .

Sub XYZ()
  Dim arr(), res()
  Dim sRow&, i&, j&, c&, k&, ma
 
  With Sheets("Data") '"Data" là ten sheet chua du lieu
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 4 + 9 * 3)
  For i = 1 To sRow
    If ma <> arr(i, 1) Then
      ma = arr(i, 1)
      k = k + 1
      For j = 1 To 4
        If c < 6 Then c = j Else c = c + 9
        res(k, j) = arr(i, j)
      Next j
    End If
    res(k, j) = arr(i, 5)
    res(k, j + 9) = arr(i, 6)
    res(k, j + 18) = arr(i, 7)
    j = j + 1
  Next i
  With Sheet4 'sheet ket qua
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:AE" & i).Clear
    .Range("A2").Resize(k, 4).NumberFormat = "@"
    .Range("A2").Resize(k, UBound(res, 2)) = res
    Range("A2").Resize(k, UBound(res, 2)).Borders.LineStyle = 1
  End With
End Sub

Em làm được rồi ạ, em cảm ơn bác nhiều

 

[cuonggps]

Chỉnh sr = sRow / 5 thành sr = sRow

được rồi bác ạ, cảm ơn bác nhiều !