... (1 người xem)

[HeSanbi]

...

 

[phulien1902]

Mình có file dữ liệu này các pro giúp đỡ chuyển từ bảng 1 sang bảng rút gọn bằng marco VBA ! thanks....

Bạn chép Code dưới đây vào :

Sub ABC()
Call BoMerge
Call XoaDongTrong
End Sub
Sub BoMerge()
    [B4:f103].UnMerge
End Sub
Sub XoaDongTrong()
    Application.ScreenUpdating = False
    Dim Rng As Range
    LR = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("b4:b" & LR)
    Rng.AutoFilter
    Rng.AutoFilter Field:=1, Criteria1:=""
    Range("b5:b" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.AutoFilterMode = False
End Sub

Tham khảo File đính kèm.

 

[HeSanbi]

với file có 100000 hàng thì VBA này không tính được, có cách khac không phulien1902

 

[HungQuoc49]

Mình có file dữ liệu này các pro giúp đỡ chuyển từ bảng 1 sang bảng rút gọn bằng marco VBA ! thanks....

Public Sub CD()
Dim DL, kq(), r As Long, c As Long, i

DL = Sheet2.Range("A2", "F" & Sheet2.Range("A1000000").End(xlUp).Row)
ReDim kq(1 To UBound(DL), 1 To UBound(DL, 2))

For r = 1 To UBound(DL) Step 2
i = i + 1
kq(i, 1) = i - 1

For c = 2 To UBound(DL, 2)
kq(i, c) = DL(r, c)
Next c
Next r
kq(1, 1) = ""

With Sheet2
.Range("Q3").Resize(i, UBound(DL, 2)).ClearContents
.Range("Q3").Resize(i, UBound(DL, 2)) = kq
End With
End Sub