Chuyển giá trị từ hàng dọc sang hàng ngang hợp với điều kiện (5 người xem)

[truong124]

Chào mọi người, em gặp vấn đề với công việc, em cần chuyển đổi ở Cột H sang thành hàng, tương ứng với các lí trình và các lớp như ở file dưới đây. Mong mọi người giúp đỡ.

Bài đã được tự động gộp: 15/6/18

không ai giúp đỡ em với ạ

 

[Lê Hồng Minh83]

Chào mọi người, em gặp vấn đề với công việc, em cần chuyển đổi ở Cột H sang thành hàng, tương ứng với các lí trình và các lớp như ở file dưới đây. Mong mọi người giúp đỡ.

Bài đã được tự động gộp: 15/6/18

không ai giúp đỡ em với ạ

Bạn kiểm tra xem đúng chưa nha
L3=SUMPRODUCT(--($C$3:$C$2218=$J3),--($D$3:$D$2218=RIGHT(L$2,LEN(L$2)-FIND(" ",L$2))*1),$H$3:$H$2218)

 

[truong124]

Bạn kiểm tra xem đúng chưa nha
L3=SUMPRODUCT(--($C$3:$C$2218=$J3),--($D$3:$D$2218=RIGHT(L$2,LEN(L$2)-FIND(" ",L$2))*1),$H$3:$H$2218)

Cảm ơn bạn, nhưng có cái đối với file của bạn thì mình làm được, nhưng sao cũng câu lệnh đó mà sang file của mình lại không được nhỉ????

 

[Lê Hồng Minh83]

Cảm ơn bạn, nhưng có cái đối với file của bạn thì mình làm được, nhưng sao cũng câu lệnh đó mà sang file của mình lại không được nhỉ????

Hay vậy ta . File bạn gửi lên vẫn là file của bạn mà, mình có thay đổi gì đâu. Bạn gửi lại cái file của bạn lên xem có gì khác không nếu nó không phải là bí mật

 

[truong124]

Hay vậy ta . File bạn gửi lên vẫn là file của bạn mà, mình có thay đổi gì đâu. Bạn gửi lại cái file của bạn lên xem có gì khác không nếu nó không phải là bí mật

À mình nhầm một vài giá trị nên không được, cái này áp dụng cho khá nhiều file của mình, giờ được rồi.
Một lần nữa cảm ơn bạn đã giúp đỡ, mình cũng làm hàm sumproduct nhưng mãi không ra được, lại bị xếp giục nên cũng loạn hết cả lên.

 

[♫ђöล♥ßล†♥†µ♫]

Cho em góp vui với.

Sub Tonghop()
    Dim Dic As Object, Tem As String
    Dim Rng As Range, N As Long
    Dim sArr(), dArr(), I As Long, J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("C3", Range("C" & Rows.Count).End(3)).Resize(, 6).Value
Set Rng = Range("D3", Range("D" & Rows.Count).End(3))
N = Application.Max(Rng)
ReDim dArr(1 To UBound(sArr, 1), 1 To N + 3)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 2) <> Empty Then
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K: dArr(K, 2) = Tem
            J = sArr(I, 2) + 3: dArr(K, J) = sArr(I, 6)
        Else
            J = sArr(I, 2) + 3: dArr(Dic.Item(Tem), J) = sArr(I, 6)
        End If
    End If
Next I
Range("I3").Resize(UBound(sArr, 1), UBound(sArr, 2)).ClearContents
Range("I3").Resize(K, UBound(dArr, 2)) = dArr
Set Dic = Nothing
End Sub

Oái ngại quá. Bài đăng trong Box "Hàm và công thức" mà lại đi làm bằng VBA

 

[truong124]

Cho em góp vui với.

Sub Tonghop()
    Dim Dic As Object, Tem As String
    Dim Rng As Range, N As Long
    Dim sArr(), dArr(), I As Long, J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("C3", Range("C" & Rows.Count).End(3)).Resize(, 6).Value
Set Rng = Range("D3", Range("D" & Rows.Count).End(3))
N = Application.Max(Rng)
ReDim dArr(1 To UBound(sArr, 1), 1 To N + 3)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 2) <> Empty Then
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K: dArr(K, 2) = Tem
            J = sArr(I, 2) + 3: dArr(K, J) = sArr(I, 6)
        Else
            J = sArr(I, 2) + 3: dArr(Dic.Item(Tem), J) = sArr(I, 6)
        End If
    End If
Next I
Range("I3").Resize(UBound(sArr, 1), UBound(sArr, 2)).ClearContents
Range("I3").Resize(K, UBound(dArr, 2)) = dArr
Set Dic = Nothing
End Sub

Oái ngại quá. Bài đăng trong Box "Hàm và công thức" mà lại đi làm bằng VBA

report nhé. Đùa thôi, có thêm cái vba này thì càng tốt rồi, có thêm cái để học hỏi. Cảm ơn bạn nhiều.