Nhờ giúp code copy dữ liệu dòng bằng cách nhấp chuột

[huyen891977]

Chào các bạn ! Mình hỏi các bạn vấn đề này có thể dùng VBA để thực hiện được không ? Trong file có nhiều sheet, ở sheet GhiNo mình ghi chú những thông tin của các KH còn nợ . Mình muốn khi những khách hàng trả hết nợ mình chỉ cần nhấp vào ô có liên quan đến KH đó ở cột ghi chú thì tự động ô đó đánh vào chữ R và nguyên dòng đó sẽ tự động copy sang sheet TONGHOP để in ra theo tuần (Ở sheet GhiNo mình có dùng nút lệnh để thực hiện macro xoá các dòng đã được đánh dấu R, vấn đề này mình thực hiện được)
Cảm ơn các bạn, Thân chào!

 

[Po_Pikachu]

Bác gửi lên mới làm được chứ?!
Thân.

 

[huyen891977]

Bạn xem file mẫu và giúp giùm mình nhé. Cảm ơn nhiều

 

[ndu96081631]

Bạn xem file mẫu và giúp giùm mình nhé. Cảm ơn nhiều

Code đây:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  With Range([H3], [H65536].End(xlUp))
    If Not Intersect(Target, .Offset(, 1)) Is Nothing Then
      Cancel = True
      If Target = "" Then
        Target.Value = "R"
        Target.Offset(, -8).Resize(, 9).Copy
        Sheet2.Range("A65536").End(xlUp).Offset(1).PasteSpecial
        Application.CutCopyMode = False
      End If
    End If
  End With
End Sub

Cứ Double Click vào cột I là tự động dử liệu sẽ được copy sang sheet bên
Đang thắc mắc chuyện khác: Nếu xóa chử R đi thì dử liệu bên kia có cần xóa theo không?

 

[huyen891977]

Chỉ copy tạm thời qua sheet TONGHOP để in ra theo tuần, sau khi in sẽ xóa và cứ thế tiếp tục. Mình thấy code của bạn rất hay nhưng mà phải double click (có thể one click) và mỗi lần như thế màn hình hơi bị giựt. Bạn chỉnh code lại chút nhé. Thân!

 

[cadafi]

Chỉ copy tạm thời qua sheet TONGHOP để in ra theo tuần, sau khi in sẽ xóa và cứ thế tiếp tục. Mình thấy code của bạn rất hay nhưng mà phải double click (có thể one click) và mỗi lần như thế màn hình hơi bị giựt. Bạn chỉnh code lại chút nhé. Thân!

Bạn chuyển code từ sự kiện BeforeDoubleClick thàng SelectionChange và thêm vào Application.ScreenUpdate vào nữa là giải quyết được vấn đề.

Mạng phép dùng lại code của anh NDU

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  On Error Resume Next
  With Range([H3], [H65536].End(xlUp))
    If Not Intersect(Target, .Offset(, 1)) Is Nothing Then
      Cancel = True
      If Target = "" Then
        Target.Value = "R"
        Target.Offset(, -8).Resize(, 9).Copy
        Sheet2.Range("A65536").End(xlUp).Offset(1).PasteSpecial
        Application.CutCopyMode = False
      End If
    End If
  End With
Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Chỉ copy tạm thời qua sheet TONGHOP để in ra theo tuần, sau khi in sẽ xóa và cứ thế tiếp tục. Mình thấy code của bạn rất hay nhưng mà phải double click (có thể one click) và mỗi lần như thế màn hình hơi bị giựt. Bạn chỉnh code lại chút nhé. Thân!

Single click không phải là làm không được, có điều tôi nghĩ rất dể thao tác nhầm nên cân nhắc bạn dùng Double Click
Còn như vẫn muốn Single click thì đây:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  With Range([A3], [A65536].End(xlUp))
    If Not Intersect(Target, .Offset(, 8)) Is Nothing Then
      Sheets("TONGHOP").[A4:I1000].Clear
      Target = Choose(1 - (Target = ""), "", "R")
      With .CurrentRegion
        .AutoFilter 9, "R"
        .Copy: Sheets("TONGHOP").[A4].PasteSpecial
      End With
      ActiveSheet.ShowAllData
    End If
  End With
End Sub

Cải tiến thêm 1 bước ---> Cho phép THÊM và BỚT ---> Bấm vào sẽ điền chử "R" và copy dòng ấy sang bên kia, nếu bấm vào thêm lần nữa sẽ mất chử "R" và record tương đương ở sheet bên kia cũng mất theo
Có điều xin lưu ý: Dùng Single click thì bạn không thể click 2 lần liên tiếp trên cùng 1 cell

 

[huyen891977]

Cảm ơn bạn Ca_dafi và bạn Ndu96.. nhiều lắm, cách của bác Ndu96...rất hay nhưng dễ nhầm lẫn nếu nhấp vào ô đã chọn trước đó, nếu dùng Autofilter để xóa dòng đã đánh dấu thì nó tạo những khoảng trắng giữa bảng dữ liệu (mình muốn xóa cả dòng dã chọn và những dòng kế tiếp sẽ tự động lấp vào).
Nhờ code của các bạn mình đã cải tiến theo yêu cầu, rất mong các bạn test xem file mình gởi có sai sót gì nhờ các bạn chỉ giáo, rất cảm ơn. Thân

 

[ndu96081631]

Cảm ơn bạn Ca_dafi và bạn Ndu96.. nhiều lắm, cách của bác Ndu96...rất hay nhưng dễ nhầm lẫn nếu nhấp vào ô đã chọn trước đó, nếu dùng Autofilter để xóa dòng đã đánh dấu thì nó tạo những khoảng trắng giữa bảng dữ liệu (mình muốn xóa cả dòng dã chọn và những dòng kế tiếp sẽ tự động lấp vào).
Nhờ code của các bạn mình đã cải tiến theo yêu cầu, rất mong các bạn test xem file mình gởi có sai sót gì nhờ các bạn chỉ giáo, rất cảm ơn. Thân

Bạn nói khó hiểu quá. Tôi "diển giãi" lại xem đúng ý bạn không nha:
- Nếu ta đánh dấu "R" vào cột I thì nguyên dòng đó được copy sang sheet TONGHOP
- Đồng thời sẽ xóa đi dòng vừa đánh dấu
Nếu đúng thế thì sửa lại:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  With Range([H3], [H65536].End(xlUp))
    If Not Intersect(Target, .Offset(, 1)) Is Nothing And Target.Count = 1 Then
      Target = Choose(1 - (Target = ""), "", "R")
      Target.Offset(, -8).Resize(, 9).Copy
      Sheets("TONGHOP").Range("A65536").End(xlUp).Offset(1).PasteSpecial
      'Application.CutCopyMode = False
      Target.EntireRow.Delete
    End If
  End With
End Sub

Dù sao tôi vẫn cảm giác vụ "One Click" này quá nguy hiểm ---> Dể nhầm lẩn

 

[huyen891977]

Bạn nói khó hiểu quá. Tôi "diển giãi" lại xem đúng ý bạn không nha:
- Nếu ta đánh dấu "R" vào cột I thì nguyên dòng đó được copy sang sheet TONGHOP
- Đồng thời sẽ xóa đi dòng vừa đánh dấu
Ý mình là vậy, nhưng cách của bạn hơi khó thực hiện cho người khác sử dụng, file này mình làm giùm một người bạn, và mình đã làm xong nhờ các bạn đã giúp, mình gởi lại file NKNnew.XLS nhờ bạn test xem có bị lỗi gì không, mình thấy cách thực hiện trong file mình gởi dễ thực hiện hơn cho người mới sử dụng Excel. Thân

 

[ndu96081631]

mình gởi lại file NKNnew.XLS nhờ bạn test xem có bị lỗi gì không, mình thấy cách thực hiện trong file mình gởi dễ thực hiện hơn cho người mới sử dụng Excel. Thân

Lổi cũng có đó:
- Khi vô tình quét chọn nhiều cell ở cột I thì nó đánh dấu "R" tất tần tật
- Việc xóa dòng đâu cần vòng lập ---> Dùng AutoFilter hoặc SpecialCells để xóa ---> Nếu dủ liệu vài ngàn dòng mà bạn For thế thì biết đến bao giờ mới xong!
Vi dụ có thể thay vòng lập thành:

Sub XOADONG()
  On Error Resume Next
   With Range("A4").CurrentRegion.Offset(1, 8).Resize(, 1)
     .SpecialCells(2).EntireRow.Delete
   End With
End Sub

Hoặc:

Sub XOADONG()
   With Range("A4").CurrentRegion
     .AutoFilter 9, "R"
     .Offset(1).SpecialCells(12).EntireRow.Delete
   End With
   ActiveSheet.AutoFilterMode = False
End Sub