Nhờ các bác giúp em file excel này với. Em cảm ơn! (2 người xem)

[dinhkien85]

Chuyển hàng thành cột. Các bác mở file ra là biết ý định của em ạ

 

[Phuocam]

Public Sub Test()
Dim lr, lc, i, j, k As Long
Dim sArr(), dArr()
lr = Range("A" & Rows.Count).End(xlUp).Row
sArr = Range("A2:Q" & lr).Value
lr = UBound(sArr, 1)
lc = UBound(sArr, 2)
ReDim dArr(1 To lr * lc, 1 To 3)
    For i = 1 To lr
        For j = 3 To lc
                If sArr(i, j) <> "" Then
                        k = k + 1
                        dArr(k, 1) = sArr(i, j)
                        dArr(k, 2) = sArr(i, 2)
                        dArr(k, 3) = sArr(i, 1)
                End If
        Next j
    Next i
If k > 0 Then Range("S2").Resize(k, 3) = dArr
End Sub

 

[dinhkien85]

Public Sub Test()
Dim lr, lc, i, j, k As Long
Dim sArr(), dArr()
lr = Range("A" & Rows.Count).End(xlUp).Row
sArr = Range("A2:Q" & lr).Value
lr = UBound(sArr, 1)
lc = UBound(sArr, 2)
ReDim dArr(1 To lr * lc, 1 To 3)
    For i = 1 To lr
        For j = 3 To lc
                If sArr(i, j) <> "" Then
                        k = k + 1
                        dArr(k, 1) = sArr(i, j)
                        dArr(k, 2) = sArr(i, 2)
                        dArr(k, 3) = sArr(i, 1)
                End If
        Next j
    Next i
If k > 0 Then Range("S2").Resize(k, 3) = dArr
End Sub

quá ok bác ạ. Cảm ơn bác nhiều nhé!