Code chuyển cột thành hàng (1 người xem)

  • Thread starter Thread starter lhthai
  • Ngày gửi Ngày gửi

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

lhthai

Thành viên thường trực
Tham gia
1/9/07
Bài viết
309
Được thích
27
Mình đang làm code copy từ cột qua cột chỉ đổi thứ tự cột thôi
Mình hỏi thử code này sữa lại copy thành dòng được không
Mã:
[COLOR=#0000cd]Private Sub CommandButton2_Click()[/COLOR]
[COLOR=#0000cd]Dim data(), kq(1 To 10000, 1 To 4), i, j, k, l[/COLOR]
[COLOR=#0000cd]data = Range("A5", [D1000].End(xlUp)).Value[/COLOR]
[COLOR=#0000cd]For i = 1 To UBound(data, 1)[/COLOR]
[COLOR=#0000cd]k = k + 1[/COLOR]
[COLOR=#0000cd]kq(k, 1) = data(i, 2)[/COLOR]
[COLOR=#0000cd]kq(k, 2) = data(i, 1)[/COLOR]
[COLOR=#0000cd]kq(k, 3) = data(i, 3)[/COLOR]
[COLOR=#0000cd]kq(k, 4) = data(i, 4)[/COLOR]
[COLOR=#0000cd]Next[/COLOR]
[COLOR=#0000cd]Range("K5").Resize(k, 4) = kq[/COLOR]
[COLOR=#0000cd]End Sub

[/COLOR]
 
Mình đang làm code copy từ cột qua cột chỉ đổi thứ tự cột thôi
Mình hỏi thử code này sữa lại copy thành dòng được không
Mã:
[COLOR=#0000cd]Private Sub CommandButton2_Click()[/COLOR]
[COLOR=#0000cd]Dim data(), kq(1 To 10000, 1 To 4), i, j, k, l[/COLOR]
[COLOR=#0000cd]data = Range("A5", [D1000].End(xlUp)).Value[/COLOR]
[COLOR=#0000cd]For i = 1 To UBound(data, 1)[/COLOR]
[COLOR=#0000cd]k = k + 1[/COLOR]
[COLOR=#0000cd]kq(k, 1) = data(i, 2)[/COLOR]
[COLOR=#0000cd]kq(k, 2) = data(i, 1)[/COLOR]
[COLOR=#0000cd]kq(k, 3) = data(i, 3)[/COLOR]
[COLOR=#0000cd]kq(k, 4) = data(i, 4)[/COLOR]
[COLOR=#0000cd]Next[/COLOR]
[COLOR=#0000cd]Range("K5").Resize(k, 4) = kq[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]



Sửa được, nhưng phải sửa khoảng 90% số code.
Copy/paste transpose có lẽ dễ hơn.
 
Upvote 0
Mình đang làm code copy từ cột qua cột chỉ đổi thứ tự cột thôi
Mình hỏi thử code này sữa lại copy thành dòng được không
Mã:
[COLOR=#0000cd]Private Sub CommandButton2_Click()[/COLOR]
[COLOR=#0000cd]Dim data(), kq(1 To 10000, 1 To 4), i, j, k, l[/COLOR]
[COLOR=#0000cd]data = Range("A5", [D1000].End(xlUp)).Value[/COLOR]
[COLOR=#0000cd]For i = 1 To UBound(data, 1)[/COLOR]
[COLOR=#0000cd]k = k + 1[/COLOR]
[COLOR=#0000cd]kq(k, 1) = data(i, 2)[/COLOR]
[COLOR=#0000cd]kq(k, 2) = data(i, 1)[/COLOR]
[COLOR=#0000cd]kq(k, 3) = data(i, 3)[/COLOR]
[COLOR=#0000cd]kq(k, 4) = data(i, 4)[/COLOR]
[COLOR=#0000cd]Next[/COLOR]
[COLOR=#0000cd]Range("K5").Resize(k, 4) = kq[/COLOR]
[COLOR=#0000cd]End Sub
[/COLOR]



Bạn sửa thành vầy xem:

Mã:
Sub test()    
    Dim data(), kq(), i, j, k, l
    data = Range("A5", [D1000].End(xlUp)).Value
    For i = 1 To UBound(data, 1)
    k = k + 1
    ReDim Preserve kq(1 To 10000, 1 To k)
    kq(1, k) = data(i, 2)
    kq(2, k) = data(i, 1)
    kq(3, k) = data(i, 3)
    kq(4, k) = data(i, 4)
    Next
    Range("P10").Resize(4, k) = kq
End Sub
 
Upvote 0
Bạn sửa thành vầy xem:

Mã:
Sub test()    
    Dim data(), kq(), i, j, k, l
    data = Range("A5", [D1000].End(xlUp)).Value
    For i = 1 To UBound(data, 1)
    k = k + 1
    ReDim Preserve kq(1 To 10000, 1 To k)
    kq(1, k) = data(i, 2)
    kq(2, k) = data(i, 1)
    kq(3, k) = data(i, 3)
    kq(4, k) = data(i, 4)
    Next
    Range("P10").Resize(4, k) = kq
End Sub

Cũng may là chỉ có 4 cột chứ nếu không thì mỏi tay luôn
Hay là thế này đi
PHP:
Sub Transpose()
Dim data(), i, j, kq()
data = Range("A5", [D1000].End(3)).Value
ReDim kq(1 To UBound(data, 2), 1 To UBound(data))
For i = 1 To UBound(data)
   For j = 1 To UBound(data, 2)
      kq(j, i) = data(i, j)
   Next
Next
Range("G5").Resize(UBound(kq), UBound(kq, 2)) = kq
End Sub
 
Upvote 0
Cũng may là chỉ có 4 cột chứ nếu không thì mỏi tay luôn
Hay là thế này đi
PHP:
Sub Transpose()
Dim data(), i, j, kq()
data = Range("A5", [D1000].End(3)).Value
ReDim kq(1 To UBound(data, 2), 1 To UBound(data))
For i = 1 To UBound(data)
   For j = 1 To UBound(data, 2)
      kq(j, i) = data(i, j)
   Next
Next
Range("G5").Resize(UBound(kq), UBound(kq, 2)) = kq
End Sub

Ko đc đâu anh Hải ơi, vì dòng cột của tác giả lộn lung tung lên mà. Nếu dự liệu nguồn mà có hàng trăm dòng thì phải tìm cách khác thôi.
 
Upvote 0
Mình đang làm code copy từ cột qua cột chỉ đổi thứ tự cột thôi
Mình hỏi thử code này sữa lại copy thành dòng được không
Mã:
[COLOR=#0000cd]Private Sub CommandButton2_Click()[/COLOR]
[COLOR=#0000cd]Dim data(), kq(1 To 10000, 1 To 4), i, j, k, l[/COLOR]
[COLOR=#0000cd]data = Range("A5", [D1000].End(xlUp)).Value[/COLOR]
[COLOR=#0000cd]For i = 1 To UBound(data, 1)[/COLOR]
[COLOR=#0000cd]k = k + 1[/COLOR]
[COLOR=#0000cd]kq(k, 1) = data(i, 2)[/COLOR]
[COLOR=#0000cd]kq(k, 2) = data(i, 1)[/COLOR]
[COLOR=#0000cd]kq(k, 3) = data(i, 3)[/COLOR]
[COLOR=#0000cd]kq(k, 4) = data(i, 4)[/COLOR]
[COLOR=#0000cd]Next[/COLOR]
[COLOR=#0000cd]Range("K5").Resize(k, 4) = kq[/COLOR]
[COLOR=#0000cd]End Sub

[/COLOR]

Thử chơi kiểu khoai lang này đi
PHP:
Sub CopyCot_ToDong()
    Range("A5:D100").Copy
    Range("P11").PasteSpecial (3), Transpose:=True
End Sub
 
Upvote 0

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

Back
Top Bottom