- Tham gia
- 23/3/16
- Bài viết
- 705
- Được thích
- 52
Nếu dữ liệu ít thì bạn dùng tạm cái này xemEm gửi File mọi người xem giúp em. Giai diện mới em không biết gửi chổ nào nữa Huhu
Sub HeloGood()
Dim i As Long, j As Long, Rc As Long, R As Long, C As Long
Application.ScreenUpdating = False
R = 3: Rc = 3
With Sheet2
.Range("I3:J100").ClearContents
For i = 3 To 10
C = .Range("H" & i).End(xlToLeft).Column
.Range("I" & Rc) = .Cells(i, C)
Rc = Rc + 1
For j = 1 To C - 1
.Range("J" & R) = .Cells(i, j)
R = R + 1
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub
Tặng bạn 1 Sub theo điều kiện của bạn.Em gửi File mọi người xem giúp em. Giai diện mới em không biết gửi chổ nào nữa Huhu
Public Sub GPE()
Dim sArr(), dArr(1 To 56, 1 To 2), I As Long, J As Long, K1 As Long, K2 As Long
sArr = Range("A3:G10").Value
For I = 1 To 8
For J = 1 To 7
If sArr(I, J) <> Empty Then
K2 = K2 + 1: dArr(K2, 2) = sArr(I, J)
End If
Next J
K1 = K1 + 1: dArr(K1, 1) = dArr(K2, 2): K2 = K2 - 1
Next I
Range("I3:J50").ClearContents
Range("I3:J3").Resize(K2) = dArr
End Sub
Tặng bạn 1 Sub theo điều kiện của bạn.
Mã:Public Sub GPE() Dim sArr(), dArr(1 To 56, 1 To 2), I As Long, J As Long, K1 As Long, K2 As Long sArr = Range("A3:G10").Value For I = 1 To 8 For J = 1 To 7 If sArr(I, J) <> Empty Then K2 = K2 + 1: dArr(K2, 2) = sArr(I, J) End If Next J K1 = K1 + 1: dArr(K1, 1) = dArr(K2, 2): K2 = K2 - 1 Next I Range("I3:J50").ClearContents Range("I3:J3").Resize(K2) = dArr End Sub
Nếu dữ liệu ít thì bạn dùng tạm cái này xem
Mã:Sub HeloGood() Dim i As Long, j As Long, Rc As Long, R As Long, C As Long Application.ScreenUpdating = False R = 3: Rc = 3 With Sheet2 .Range("I3:J100").ClearContents For i = 3 To 10 C = .Range("H" & i).End(xlToLeft).Column .Range("I" & Rc) = .Cells(i, C) Rc = Rc + 1 For j = 1 To C - 1 .Range("J" & R) = .Cells(i, j) R = R + 1 Next j Next i End With Application.ScreenUpdating = True End Sub