Help: chuyển đổi dữ liệu từ dọc sang hàng ngang

[hvt42000]

Kính gửi anh chị

Vì em mới "đụng chạm" excel nên còn lúng túng
Hiện tại em có bảng dữ liệu như hình 1
gồm tên thiết bị, tần suất bảo dưỡng thiết bị như bào nhiêu tuần/tháng/năm phải tu bổ thiết bị 1 lần
Giờ sếp có yêu cầu sắp xếp theo hàng ngang như hình 2
gồm 1 cột thiết bị, hàng ngang là tần suất bảo dưỡng, thiết bị nào có tần suất thì tick "x" vào ô
1 thiết bị có thể có nhiều lần tu bổ

em kiểm tra thấy ko có lệnh nào đáp ứng
File đinh kèm là ví dụ điển hình (em copy 1 ít để đỡ nhẹ file)
file chính thức có khoảng hơn 40k dòng

Kinh nhờ các pro chỉ điểm giúp

 

[huuthang_bd]

Mã T-1102 từ dữ liệu gốc là 1 year, sao kết quả lại bao gồm 1 week, 4 weeks và 6 months vậy bạn?

 

[hvt42000]

Mã T-1102 từ dữ liệu gốc là 1 year, sao kết quả lại bao gồm 1 week, 4 weeks và 6 months vậy bạn?

cái 1W, 4W, 6M là mình ví dụ thôi
ý là 1 thiết bị có thể có nhiều giá đoạn tu bổ
có thể chỉ có 1 giai đoạn, cũng có thể có nhiều giai đoạn

 

[snow25]

Kính gửi anh chị

Vì em mới "đụng chạm" excel nên còn lúng túng
Hiện tại em có bảng dữ liệu như hình 1
gồm tên thiết bị, tần suất bảo dưỡng thiết bị như bào nhiêu tuần/tháng/năm phải tu bổ thiết bị 1 lần
Giờ sếp có yêu cầu sắp xếp theo hàng ngang như hình 2
gồm 1 cột thiết bị, hàng ngang là tần suất bảo dưỡng, thiết bị nào có tần suất thì tick "x" vào ô
1 thiết bị có thể có nhiều lần tu bổ

em kiểm tra thấy ko có lệnh nào đáp ứng
File đinh kèm là ví dụ điển hình (em copy 1 ít để đỡ nhẹ file)
file chính thức có khoảng hơn 40k dòng

Kinh nhờ các pro chỉ điểm giúp

Bạn thử cái sub này nhé.

Sub linhtinh()
    Dim arr, data, i As Long, LR As Long, dk As String, dic As Object, a As Long, b As Long, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet3")
         LR = .Range("A" & Rows.Count).End(xlUp).Row
         If LR < 3 Then Exit Sub
         .Range("B3:AE" & LR).ClearContents
         arr = .Range("A1:AE" & LR).Value
    End With
        For i = 3 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        For i = 2 To UBound(arr, 2)
            If arr(1, i) = Empty Then arr(1, i) = arr(1, i - 1)
            dk = arr(1, i) & arr(2, i)
            dic.Item(dk) = i
        Next i
    With Sheets("data")
         lr1 = .Range("A" & Rows.Count).End(xlUp).Row
         data = .Range("A2:D" & lr1).Value
         For i = 1 To UBound(data)
            dk = data(i, 1)
            a = dic.Item(dk)
            If a Then
               dk = data(i, 4) & data(i, 3)
               b = dic.Item(dk)
                  If b Then
                     arr(a, b) = "X"
                  End If
            End If
        Next i
   End With
   With Sheets("Sheet3")
       .Range("A1:AE" & LR).Value = arr
   End With
End Sub

 

[hvt42000]

Bạn thử cái sub này nhé.

Sub linhtinh()
    Dim arr, data, i As Long, LR As Long, dk As String, dic As Object, a As Long, b As Long, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet3")
         LR = .Range("A" & Rows.Count).End(xlUp).Row
         If LR < 3 Then Exit Sub
         .Range("B3:AE" & LR).ClearContents
         arr = .Range("A1:AE" & LR).Value
    End With
        For i = 3 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        For i = 2 To UBound(arr, 2)
            If arr(1, i) = Empty Then arr(1, i) = arr(1, i - 1)
            dk = arr(1, i) & arr(2, i)
            dic.Item(dk) = i
        Next i
    With Sheets("data")
         lr1 = .Range("A" & Rows.Count).End(xlUp).Row
         data = .Range("A2:D" & lr1).Value
         For i = 1 To UBound(data)
            dk = data(i, 1)
            a = dic.Item(dk)
            If a Then
               dk = data(i, 4) & data(i, 3)
               b = dic.Item(dk)
                  If b Then
                     arr(a, b) = "X"
                  End If
            End If
        Next i
   End With
   With Sheets("Sheet3")
       .Range("A1:AE" & LR).Value = arr
   End With
End Sub

Cảm ơn bạn Snow25 nhé
đoạn Sub chạy rất chuẩn