Dùng hàm chuyển dữ liệu hàng ngang sang cột dọc có điều kiện (3 người xem)

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

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

le_vis

Thành viên tích cực
Tham gia
23/7/09
Bài viết
1,322
Được thích
813
Mọi chi tiết xin các bạn xem file đính kèm. Kính mong nhận được sự trợ giúp của các bạn . XIN TRÂN TRỌNG CẢM ƠN
 

File đính kèm

Mọi chi tiết xin các bạn xem file đính kèm. Kính mong nhận được sự trợ giúp của các bạn . XIN TRÂN TRỌNG CẢM ƠN
2 File có liên quan gì đến nhau đâu nhỉ.Bạn xem lại file gửi lên.
Bạn giải thích rõ lấy sang thế nào nhé.
 
2 File có liên quan gì đến nhau đâu nhỉ.Bạn xem lại file gửi lên.
Bạn giải thích rõ lấy sang thế nào nhé.
Đúng File rồi mà bạn ơi - Mình đã giải thích rõ và cập nhật thử bằng tay ngày 10/11/2018 sang bên Sheet LENH rồi mà bạn. Bạn xem lại giúp mình nhé - Cảm ơn bạn đã quan tâm
 
Đúng File rồi mà bạn ơi - Mình đã giải thích rõ và cập nhật thử bằng tay ngày 10/11/2018 sang bên Sheet LENH rồi mà bạn. Bạn xem lại giúp mình nhé - Cảm ơn bạn đã quan tâm
Đây bạn xem.Không dùng công thức nhé.
Mã:
Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long
Dim s As String, s2 As String
Dim s1 As String
Dim dk As String
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    s2 = .Range("C1").Value
    arr = .Range("B5:o" & .Range("C" & Rows.Count).End(xlUp).Row).Value
End With
With Sheet2
    arr1 = .Range("b8:D14").Value
    s = .Range("D4").Value
     For i = 3 To UBound(arr, 1)
         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
            For j = 6 To 12
            If arr(i, j) <> Empty Then
                dk = arr(i, 1) & "#" & arr(1, j)
                If dic.exists(dk) = 0 Then
                   If arr(i, 2) = s2 Then
                     m = arr(i, j)
                   Else
                     m = arr(i, 2) & " = " & arr(i, j)
                   End If
                   dic.Item(dk) = Array(m)
                Else
                   s = dic.Item(dk)(0)
                   If arr(i, 2) = s2 Then
                      s = s & " va " & arr(i, j)
                   Else
                      s = s & " va " & arr(i, 2) & " = " & arr(i, j)
                   End If
                   dic.Item(dk) = Array(s)
                End If
           End If
            Next j
    Next i
    For i = 1 To 7
        s1 = .Range("D4").Value
        dk = s1 & "#" & arr1(i, 2)
        If dic.exists(dk) Then
           arr1(i, 3) = dic.Item(dk)(0)
        Else
           arr1(i, 3) = Empty
        End If
   Next i
   .Range("B8:d14").Value = arr1
 End With
End Sub
 

File đính kèm

Đây bạn xem.Không dùng công thức nhé.
Mã:
Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long
Dim s As String, s2 As String
Dim s1 As String
Dim dk As String
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    s2 = .Range("C1").Value
    arr = .Range("B5:o" & .Range("C" & Rows.Count).End(xlUp).Row).Value
End With
With Sheet2
    arr1 = .Range("b8:D14").Value
    s = .Range("D4").Value
     For i = 3 To UBound(arr, 1)
         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
            For j = 6 To 12
            If arr(i, j) <> Empty Then
                dk = arr(i, 1) & "#" & arr(1, j)
                If dic.exists(dk) = 0 Then
                   If arr(i, 2) = s2 Then
                     m = arr(i, j)
                   Else
                     m = arr(i, 2) & " = " & arr(i, j)
                   End If
                   dic.Item(dk) = Array(m)
                Else
                   s = dic.Item(dk)(0)
                   If arr(i, 2) = s2 Then
                      s = s & " va " & arr(i, j)
                   Else
                      s = s & " va " & arr(i, 2) & " = " & arr(i, j)
                   End If
                   dic.Item(dk) = Array(s)
                End If
           End If
            Next j
    Next i
    For i = 1 To 7
        s1 = .Range("D4").Value
        dk = s1 & "#" & arr1(i, 2)
        If dic.exists(dk) Then
           arr1(i, 3) = dic.Item(dk)(0)
        Else
           arr1(i, 3) = Empty
        End If
   Next i
   .Range("B8:d14").Value = arr1
End With
End Sub
Cảm ơn bạn - Rất chuẩn . Nhưng cô bạn tôi chỉ muốn dùng công thức cho dễ tùy biến khi phát sinh trong quá trình sử dụng - Các Bạn có thể cho phương án dùng hàm được không ? Xin lỗi vì đã làm phiền bạn
 
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom