Cho em xin cách chuyển đổi dữ liệu từ cột dọc sang hàng ngang (4 người xem)

  • Thread starter Thread starter NLan90
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

NLan90

Thành viên mới
Tham gia
3/3/19
Bài viết
2
Được thích
0
Xin chào mọi người,
Em có một data được sắp theo thứ tự cột dọc, giờ em muốn chuyển thành hàng ngang thì không biết làm thế nào.
Em không thể copy paste transpose hoặc dùng hàm transpose được vì tất cả sẽ thành hàng hết (do em vẫn muốn sắp theo thứ tự mã số nhân viên là hàng dọc).
Có thể em giải thích hơi khó hiểu nên em đính kèm data mẫu để mọi người coi. (Data thật của em lớn, hơn 8000 dòng ạ)
Mong các anh chị giúp em.
 

File đính kèm

Mình cho rằng cái ni cần sự trợ giúp từ VBA mới đặng!
Nhất là số dòng dữ liệu 8.000 dòng thế kia
Nếu bạn chịu chúng ta sẽ tiếp!
 
Xin chào mọi người,
Em có một data được sắp theo thứ tự cột dọc, giờ em muốn chuyển thành hàng ngang thì không biết làm thế nào.
Em không thể copy paste transpose hoặc dùng hàm transpose được vì tất cả sẽ thành hàng hết (do em vẫn muốn sắp theo thứ tự mã số nhân viên là hàng dọc).
Có thể em giải thích hơi khó hiểu nên em đính kèm data mẫu để mọi người coi. (Data thật của em lớn, hơn 8000 dòng ạ)
Mong các anh chị giúp em.
Chạy thử code này
Mã:
Sub DATA()
Dim Nguon
Dim Cot
Dim DS
Dim Chuoi
Dim Kq
Dim i, j, k, x, z
Nguon = Sheet1.Range("a2", Sheet1.Range("f2").End(xlDown))
Cot = UBound(Nguon, 2)
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(Nguon)
        Chuoi = Nguon(i, 1) & "|" & Nguon(i, 2)
        If .exists(Chuoi) = 0 Then
            ReDim DS(Cot - 2)
            DS(0) = Cot - 2
            For j = 3 To Cot
                DS(j - 2) = Nguon(i, j)
            Next j
            .Add Chuoi, DS
        Else
            DS = .Item(Chuoi)
            DS(0) = DS(0) + (Cot - 2)
            If k < DS(0) Then k = DS(0)
            x = UBound(DS)
            ReDim Preserve DS(x + Cot - 2)
            For j = 3 To Cot
                DS(x + j - 2) = Nguon(i, j)
            Next j
            .Item(Chuoi) = DS
        End If
    Next i
    ReDim Kq(1 To .Count + 1, 1 To k + 2)
    Kq(1, 1) = Nguon(1, 1)
    Kq(1, 2) = Nguon(1, 2)
    z = 0
    For j = 3 To k Step (Cot - 2)
        z = z + 1
        Kq(1, j) = Nguon(1, 3) & " " & z
        For x = j + 1 To j + (Cot - 2) - 1
            Kq(1, x) = Nguon(1, x - j + 3)
        Next x
    Next j
    i = 1
    For Each Chuoi In .keys
        DS = .Item(Chuoi)
        i = i + 1
        Chuoi = Split(Chuoi, "|")
        Kq(i, 1) = Chuoi(0)
        Kq(i, 2) = Chuoi(1)
        For j = 1 To DS(0)
            Kq(i, j + 2) = DS(j)
        Next j
    Next Chuoi
End With
With Sheet1
.Range("a25").Resize(UBound(Kq), UBound(Kq, 2)).ClearContents
.Range("a25").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
.Range("a25").Resize(UBound(Kq), UBound(Kq, 2)).Borders.LineStyle = 1
.Range("a25").Resize(1, UBound(Kq, 2)).Font.Bold = True
End With
End Sub
 
Bài này có nhiều vấn đề:

Người phụ thuộc trong một ID tối đa là bao nhiêu?

Dữ liệu trên 8000 dòng, kết quả nên xuất sang 1 sheet riêng.

Nếu ID chắc chắn không trùng thì không cần ghép cột 1 với cột 2

Nếu dữ liệu sắp xếp theo ID, việc chuyển dữ liệu dễ hơn.
 
Xin chào mọi người,
Em có một data được sắp theo thứ tự cột dọc, giờ em muốn chuyển thành hàng ngang thì không biết làm thế nào.
Em không thể copy paste transpose hoặc dùng hàm transpose được vì tất cả sẽ thành hàng hết (do em vẫn muốn sắp theo thứ tự mã số nhân viên là hàng dọc).
Có thể em giải thích hơi khó hiểu nên em đính kèm data mẫu để mọi người coi. (Data thật của em lớn, hơn 8000 dòng ạ)
Mong các anh chị giúp em.
Nếu chịu dùng VBA thì bạn xem file này.
Tiêu đề các cột bạn nhập thủ công nhé.
 

File đính kèm

Bài này có nhiều vấn đề:

Người phụ thuộc trong một ID tối đa là bao nhiêu?

Dữ liệu trên 8000 dòng, kết quả nên xuất sang 1 sheet riêng.

Nếu ID chắc chắn không trùng thì không cần ghép cột 1 với cột 2

Nếu dữ liệu sắp xếp theo ID, việc chuyển dữ liệu dễ hơn.
Đoạn code ở trên nối cột 1 & 2 cũng chỉ là để tiện cho vòng lăp điền tên người phụ thuôc ở sau thôi bác, còn ID chắc là duy nhất rồi.
 
Bài này có thể không dùng dic nếu sắp xếp.
 
Lần chỉnh sửa cuối:
Bài này có nhiều vấn đề:

Người phụ thuộc trong một ID tối đa là bao nhiêu?

Dữ liệu trên 8000 dòng, kết quả nên xuất sang 1 sheet riêng.

Nếu ID chắc chắn không trùng thì không cần ghép cột 1 với cột 2

Nếu dữ liệu sắp xếp theo ID, việc chuyển dữ liệu dễ hơn.


- Không có tối đa số NPT trong mỗi ID
- Chắc chắn ID không trùng (Mỗi nhân viên chỉ có 1 ID duy nhất - họ có nhiều người NPT đi theo)
- Dữ liệu sẽ được sắp xếp theo ID
Bài đã được tự động gộp:

Mình cho rằng cái ni cần sự trợ giúp từ VBA mới đặng!
Nhất là số dòng dữ liệu 8.000 dòng thế kia
Nếu bạn chịu chúng ta sẽ tiếp!

Dạ em cũng chỉ sử dụng excel gần đây thôi nên vẫn chưa biết nhiều cách dùng. Anh giúp em làm thử VBA nhé.
 
- (1) Không có tối đa số NPT trong mỗi ID
-
-
(2) Dạ . . . . Anh giúp em làm thử VBA nhé.
(1) Có nhưng bạn chưa muốn xác định mà thôi
(2) Có 2 bài viết VBA cho bạn rồi; Sau đây là 1 tham khảo xài mảng (Array), những mong hữu ích cho bạn thêm ít nhiều:
PHP:
Sub ChepDuLieuTheoHang()
Dim Rws As Long, J As Long, Cot As Integer, Col As Integer, W As Long, Tmp As Integer
Dim Z As Integer, CT As Integer, Max_ As Integer:                    Dim MaSo As String

Rws = [B2].CurrentRegion.Rows.Count
ReDim Arr(1 To Rws, 1 To 4 * Rws) As String
Col = [B2].CurrentRegion.Columns.Count
For J = 3 To Rws
    With Cells(J, "A")
        If Len(.Value) = 5 Then
            If .Value <> MaSo Then
                W = W + 1
                For Cot = 1 To Col
                    Arr(W, Cot) = Cells(J, Cot).Value
                Next Cot
                MaSo = .Value:                                      CT = Cot
            Else
                Z = 3
                For Tmp = CT To CT + 4
                    Arr(W, Tmp) = Cells(J, Z).Value
                    Z = Z + 1
                Next Tmp
                CT = Tmp - 1
            End If
            If Max_ < CT Then Max_ = CT
        End If
    End With
Next J
If W Then
    [A17].Resize(W, Max_ + 8).Value = Arr()
End If
End Sub
 
Web KT

Bài viết mới nhất

Back
Top Bottom