Paste dữ liệu, bỏ qua các cell ẩn (1 người xem)

leonguyenz · 5/12/24

A HOANG 620 đã viết:
Sub Paste_to_Visible_Rows()
...
End Sub

anh/chị cho hỏi cái này khi dòng ẩn thì giải quyết được tốt, nhưng cột ẩn thì khi paste ra vẫn hiện dữ liệu đã ẩn. vậy mình có khắc phục được không anh/chị?

Anh dùng phương thức PasteSpecial để copy các ô hiển thị (Visible) là được:

Mã:

Range(vùng cần copy).SpecialCells(xlCellTypeVisible).Copy
Range(ô cần paste).PasteSpecial xlPasteValues

A HOANG 620 · 7/1/25

leonguyenz đã viết:
Anh dùng phương thức PasteSpecial để copy các ô hiển thị (Visible) là được:

Mã:

Range(vùng cần copy).SpecialCells(xlCellTypeVisible).Copy Range(ô cần paste).PasteSpecial xlPasteValues

sub copypaste
Dim Nguon As Range, Dich As Range
Dim i, j As Long, r, k As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den ", Type:=8)
Nguon.Value = Nguon.Value
Dich.Value = Dich.Value
For i = 1 To Nguon.Rows.Count
For j = 1 To Nguon.Columns.Count
Nguon.SpecialCells(xlCellTypeVisible).Copy
Dich.PasteSpecial xlPasteValues
Next j
Next i
end sub

bảng dữ liệu 2000 dòng, 10 cột thì sub chạy chậm và giật thì anh chị có cách nào giúp cho chạy nhanh và không giật không? xin cám ơn

DeTong · 7/1/25

A HOANG 620 đã viết:
bảng dữ liệu 2000 dòng, 10 cột thì sub chạy chậm

Nếu đã viết code thì dùng mảng nhặt ra các dòng muốn filter, sao đó gán xuống sheet 1 lần ... thay vì copy từng cell như vậy...
Tóm lại attach file lên (chỉ cần chừng 20 dòng), kết quả mong muốn, các thành viên sẽ có code cho bạn.

A HOANG 620 · 7/1/25

DeTong đã viết:
Nếu đã viết code thì dùng mảng nhặt ra các dòng muốn filter, sao đó gán xuống sheet 1 lần ... thay vì copy từng cell như vậy...
Tóm lại attach file lên (chỉ cần chừng 20 dòng), kết quả mong muốn, các thành viên sẽ có code cho bạn.

đây là bảng nhờ anh chị giúp viết code, mình cần lấy dữ liệu cần, những cột, dòng không cần mình ẩn nó đi và khi mình dán ra bảng mình không có những dòng và cột đã ẩn

HUONGHCKT · 7/1/25

A HOANG 620 đã viết:
đây là bảng nhờ anh chị giúp viết code, mình cần lấy dữ liệu cần, những cột, dòng không cần mình ẩn nó đi và khi mình dán ra bảng mình không có những dòng và cột đã ẩn

Tham khảo code (vẫn là code cũ) và file đính kèm.

Mã:

Sub copypaste()
Dim Nguon As Range, Dich As Range

Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den ", Type:=8)
Nguon.Value = Nguon.Value
Nguon.SpecialCells(xlCellTypeVisible).Copy
Dich.PasteSpecial xlPasteValues
End Sub

Cột ABC là cột tôi thêm số thứ tự để thử.

DeTong · 8/1/25

Thay đổi các cột muốn copy theo thứ tự trong mảng cột mCot + Đánh dấu x các dòng cần lấy…

Mã:

Sub BasicCopy() 'Copy nhung dong danh dau x
    Dim mNguon() ' mang Copy
    Dim mCot()  'mang cot
    Dim mDich() ' mang Paste
   
    mNguon = Sheet2.Range("b3:p500").Value
    mCot = [{1,2,11,9,14,7}] 'Index bat dau bang 0
    ReDim mDich(1 To UBound(mNguon, 1), 1 To UBound(mCot))
   
    Dim i, j, k As Long ' bien tang vong lap
   
    For i = 1 To UBound(mNguon)
        If mNguon(i, 1) = "x" Then  ' neu cot B danh dau x
           
            k = k + 1
            For j = 1 To UBound(mCot)
                mDich(k, j) = mNguon(i, mCot(j) + 1)
            Next
           
        End If
    Next i
   
'Xoa du lieu cu
    Call Xoa
'Gan ket qua moi xuong sheet
    Sheet2.Range("s3").Resize(k, UBound(mCot)).Value = mDich

End Sub

Sub Xoa()
    Sheet2.Range("s3:az500").ClearContents
End Sub

VietHoangPhan · 8/1/25

Bác @DeTong không ngủ hay sao 3h:21 AM đã dậy gõ cọc cọc rồi ạ. hi

HeSanbi · 8/1/25

@DeTong Nếu như muốn sao chép mà vẫn giữ các ô có định dạng số, màu phông chữ, thì mã này không phù hợp. Nếu ghi bị lỗi cần chạy lại, lúc cần Undo thì bó tay.

Tham khảo thêm phương pháp xử lý XML và dán xem bạn nhé.

HeSanbi · 8/1/25

@A HOANG 620
Bạn có thể thử phiên bản sao chép mảng bằng cách xử lý XML này

Gán vào một nút nhấn:

'CopyDataTable [A1:N51],[R53]'

Gán đối số, có xác định cột:

'CopyDataTable [A1:N51],[R53], ListColumns(1,3,4,5,7, 8)'

Gán đối số tùy chọn, các đối số sau mặc định đều là xóa bỏ, muốn giữ lại thì nhập vào sau:

keepFormulas - Giữ lại biểu thức

keepRowHidden - Giữ lại dòng ẩn

keepColumnHidden - Giữ lại cột ẩn

keepRowMerge - Giữ lại ô đã gộp theo dòng

keepColumnMerge - Giữ lại ô đã gộp theo cột

keepRowBlank - Giữ lại dòng trống

'CopyDataTable [A1:N51],[R53], keepRowHidden(), ListColumns(1,3,4,5,7, 8)'

Nếu đặt nút nhấn ở trang tính khác trang tính dữ liệu hãy thêm CodeName Worksheet: Sheet1.[A1:N51]

Để tiết kiệm bộ nhớ, bạn cần sửa mã và đặt mã vào một Class Module.

A HOANG 620 · 10/1/25

HeSanbi đã viết:
@A HOANG 620
Bạn có thể thử phiên bản sao chép mảng bằng cách xử lý XML này

Gán vào một nút nhấn:

Gán đối số, có xác định cột:

Gán đối số tùy chọn, các đối số sau mặc định đều là xóa bỏ, muốn giữ lại thì nhập vào sau:

keepFormulas - Giữ lại biểu thức
keepRowHidden - Giữ lại dòng ẩn
keepColumnHidden - Giữ lại cột ẩn
keepRowMerge - Giữ lại ô đã gộp theo dòng
keepColumnMerge - Giữ lại ô đã gộp theo cột
keepRowBlank - Giữ lại dòng trống

Nếu đặt nút nhấn ở trang tính khác trang tính dữ liệu hãy thêm CodeName Worksheet: Sheet1.[A1:N51]

Để tiết kiệm bộ nhớ, bạn cần sửa mã và đặt mã vào một Class Module.

dạ cám ơn bạn đã chỉ dẫn ạ

Bài đã được tự động gộp: 10/1/25

HUONGHCKT đã viết:
Tham khảo code (vẫn là code cũ) và file đính kèm.

Mã:

Sub copypaste() Dim Nguon As Range, Dich As Range Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8) Set Dich = Application.InputBox(prompt:="Chep Den ", Type:=8) Nguon.Value = Nguon.Value Nguon.SpecialCells(xlCellTypeVisible).Copy Dich.PasteSpecial xlPasteValues End Sub

Cột ABC là cột tôi thêm số thứ tự để thử.

thay đổi nhỏ là được kết quả tốt hơn, cám ơn bạn giúp

Bài đã được tự động gộp: 10/1/25

DeTong đã viết:

Thay đổi các cột muốn copy theo thứ tự trong mảng cột mCot + Đánh dấu x các dòng cần lấy…

Mã:

Sub BasicCopy() 'Copy nhung dong danh dau x
    Dim mNguon() ' mang Copy
    Dim mCot()  'mang cot
    Dim mDich() ' mang Paste
  
    mNguon = Sheet2.Range("b3:p500").Value
    mCot = [{1,2,11,9,14,7}] 'Index bat dau bang 0
    ReDim mDich(1 To UBound(mNguon, 1), 1 To UBound(mCot))
  
    Dim i, j, k As Long ' bien tang vong lap
  
    For i = 1 To UBound(mNguon)
        If mNguon(i, 1) = "x" Then  ' neu cot B danh dau x
          
            k = k + 1
            For j = 1 To UBound(mCot)
                mDich(k, j) = mNguon(i, mCot(j) + 1)
            Next
          
        End If
    Next i
  
'Xoa du lieu cu
    Call Xoa
'Gan ket qua moi xuong sheet
    Sheet2.Range("s3").Resize(k, UBound(mCot)).Value = mDich

End Sub

Sub Xoa()
    Sheet2.Range("s3:az500").ClearContents
End Sub

cám ơn bạn đã hổ trợ mình. cách thêm 1 cách giải quyết nhanh hơn cho dữ liệu nhiều dòng, nhiều cột

HUONGHCKT · 10/1/25

A HOANG 620 đã viết:
dạ cám ơn bạn đã chỉ dẫn ạ

Bài đã được tự động gộp: 10/1/25

thay đổi nhỏ là được kết quả tốt hơn, cám ơn bạn giúp

Nhìn chung chỉ gỡ bỏ 2 vòng lặp vô ích trong code thôi là code sẽ chạy nhanh hơn mà vẫn cho ra kết quả đúng ý định.

Paste dữ liệu, bỏ qua các cell ẩn (1 người xem)

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

leonguyenz

Thành viên gạo cội

A HOANG 620

Thành viên mới

DeTong

Thành viên hoạt động

A HOANG 620

Thành viên mới

File đính kèm

HUONGHCKT

Zalo 0986997214

File đính kèm

DeTong

Thành viên hoạt động

File đính kèm

VietHoangPhan

Thành viên chính thức

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

File đính kèm

A HOANG 620

Thành viên mới

HUONGHCKT

Zalo 0986997214

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian