Đổi dữ liệu chiều ngang qua chiều dọc (1 người xem)

[hungdiep85]

Chào các Thầy


Sheet 1 là dữ liệu chiều ngang
Sheet 2 là dữ liệu đã Đổi chiều dọc


VD :
Nếu sheet 1 cột [G:N] có tên sản phẩm thì ổ sheet 2 cột [G] sẽ có tên sảm phẩm đó nhưng hiển thì chiều dọc xuống nếu ô [G:N] không có tên sảm phẩm thì sheet 2 không hiển thị luôn.


Cảm ơn các Thầy nhiêu......

 

[Ba Tê]

Chào các Thầy


Sheet 1 là dữ liệu chiều ngang
Sheet 2 là dữ liệu đã Đổi chiều dọc


VD :
Nếu sheet 1 cột [G:N] có tên sản phẩm thì ổ sheet 2 cột [G] sẽ có tên sảm phẩm đó nhưng hiển thì chiều dọc xuống nếu ô [G:N] không có tên sảm phẩm thì sheet 2 không hiển thị luôn.


Cảm ơn các Thầy nhiêu......

Thử với Sub này xem:

Public Sub GPE()
Dim Rng(), Arr(), I As Long, J As Long, N As Long, K As Long
With Sheet1
    Rng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 25).Value
End With
ReDim Arr(1 To UBound(Rng, 1) * 20, 1 To 7)
For I = 1 To UBound(Rng, 1)
    For J = 7 To 25
        If Rng(I, J) <> "" Then
            K = K + 1
            For N = 1 To 6
                Arr(K, N) = Rng(I, N)
            Next N
                Arr(K, 7) = Rng(I, J)
        End If
    Next J
Next I
With Sheet2
    .[A2:G10000].ClearContents
    .[A2].Resize(K, 7).Value = Arr
End With
End Sub

 

[hungdiep85]

thử với sub này xem:

public sub gpe()
dim rng(), arr(), i as long, j as long, n as long, k as long
with sheet1
    rng = .range(.[a2], .[a65000].end(xlup)).resize(, 25).value
end with
redim arr(1 to ubound(rng, 1) * 20, 1 to 7)
for i = 1 to ubound(rng, 1)
    for j = 7 to 25
        if rng(i, j) <> "" then
            k = k + 1
            for n = 1 to 6
                arr(k, n) = rng(i, n)
            next n
                arr(k, 7) = rng(i, j)
        end if
    next j
next i
with sheet2
    .[a2:g10000].clearcontents
    .[a2].resize(k, 7).value = arr
end with
end sub

em cảm ơn thầy nhiều àh...........