Trích dữ liệu ,kèm ngày tháng mỗi tại thời điểm mở file (2 người xem)

[leanhduy]

Trích dữ liệu ,kèm ngày tháng mỗi tại thời điểm mở file
Xin chào các bạn ! Nhờ các bạn trong diễn đàn chỉ giúp : Tôi có 1 danh sách học sinh có nhiều cột (thứ tự, họ tên.năm sinh,... ,ghi chú ) . ở cột ghi chú tôi dùng để theo dõi ,tôi muốn một khi đánh dấu "X" vào cell bất kỳ thuộc cột ghi chú ở sheet1 thì cả dòng dữ liệu (Dòng có đánh dấu"X") được trích sang sheet2 đồng thời kèm theo ở cột kế bên phải cập nhật ngày tháng tại thời điểm đánh dấu "X" ở bên sheet1 . Xin nhờ các bạn chỉ giùm ,tôi rất cảm ơn . Tôi có gởi file đính kèm dưới đây .

File đính kèm_clickhere

 

[tedaynui]

Trích dữ liệu ,kèm ngày tháng mỗi tại thời điểm mở file
Xin chào các bạn ! Nhờ các bạn trong diễn đàn chỉ giúp : Tôi có 1 danh sách học sinh có nhiều cột (thứ tự, họ tên.năm sinh,... ,ghi chú ) . ở cột ghi chú tôi dùng để theo dõi ,tôi muốn một khi đánh dấu "X" vào cell bất kỳ thuộc cột ghi chú ở sheet1 thì cả dòng dữ liệu (Dòng có đánh dấu"X") được trích sang sheet2 đồng thời kèm theo ở cột kế bên phải cập nhật ngày tháng tại thời điểm đánh dấu "X" ở bên sheet1 . Xin nhờ các bạn chỉ giùm ,tôi rất cảm ơn . Tôi có gởi file đính kèm dưới đây .

Việc này mình nghĩ cũng không khó, bạn hãy gởi lại file đi.
TDN

 

[tedaynui]

To Leanhduy

File của bạn bị nhiễm Virus XL4Popy. Mình đã diệt và làm theo yêu cầu của bạn. Bạn xoá file ở bài #1 để tránh lây nhiễm cho các bạn khác nhé.
Bạn xem file sau có theo ý bạn không nhé

TDN

 

[Mr Okebab]

To Leanhduy

File của bạn bị nhiễm Virus XL4Popy. Mình đã diệt và làm theo yêu cầu của bạn. Bạn xoá file ở bài #1 để tránh lây nhiễm cho các bạn khác nhé.
Bạn xem file sau có theo ý bạn không nhé

TDN

Xin phép bác, em cải tiến code của bác xíu nhé (Bẫy lỗi thôi mà) :

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo EndSub
    If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
    If Target.Column = 5 Then
    If UCase(Target.Value) = "X" Then
        Application.EnableEvents = False
        Dim iRow1, iRow2 As Integer
        Target.Value = "X"
        iRow1 = Target.Row
        iRow2 = Sheet2.Range("A65000").End(xlUp).Row + 1
        Sheet1.Range("F" & iRow1) = Now()
        Sheet2.Range("A" & iRow2 & ":D" & iRow2).Value = Sheet1.Range("A" & iRow1 & ":D" & iRow1).Value
    End If: End If: End If
EndSub:
    Application.EnableEvents = True
End Sub

Thân!

 

[SA_DQ]

Thêm một tham khảo, như sau

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range
 
 Set Rng = Range("A" & Target.Row & ":AA" & Target.Row)
2 ' MsgBox Rng.Address
 If Not Intersect(Target, Range("H:H")) Is Nothing And UCase$(Target) = "X" Then
    Rng.Copy Destination:=Sheet2.Range("A" & Sheet2.Cells(65432, 1).End(xlUp).Row + 1)
    Target.Offset(, 1) = Date
 End If
End Sub

 

[Mr Okebab]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range
 
 Set Rng = Range("A" & Target.Row & ":AA" & Target.Row)
2 ' MsgBox Rng.Address
 If Not Intersect(Target, Range("H:H")) Is Nothing And UCase$(Target) = "X" Then
    Rng.Copy Destination:=Sheet2.Range("A" & Sheet2.Cells(65432, 1).End(xlUp).Row + 1)
    Target.Offset(, 1) = Date
 End If
End Sub

Của bác hay lắm. Tuy nhiên :

1. Sub Change chạy 2 lần (nhận biết qua Msgbox)
2. Khi chọn nhiều hàng hay nhiều cột sẽ báo lỗi
3. Khi người ta lỡ tay nhập chữ x thì nên sửa lại thành X cho . . . đẹp!!

Thân!

 

[leanhduy]

To Leanhduy

File của bạn bị nhiễm Virus XL4Popy. Mình đã diệt và làm theo yêu cầu của bạn. Bạn xoá file ở bài #1 để tránh lây nhiễm cho các bạn khác nhé.
Bạn xem file sau có theo ý bạn không nhé

TDN

Trong quá trình theo dõi danh sách ,nếu xóa đi dấu"X" thì dòng đó sẽ trở lại tình trạng ban đầu (Trước khi chưa đánh dấu "X"- Tức là lúc này không cần hiển thị việc cập nhật ngày tháng ở dòng trích này nữa ) , xin được bạn giúp tiếp .

 

[ThuNghi]

Trong quá trình theo dõi danh sách ,nếu xóa đi dấu"X" thì dòng đó sẽ trở lại tình trạng ban đầu (Trước khi chưa đánh dấu "X"- Tức là lúc này không cần hiển thị việc cập nhật ngày tháng ở dòng trích này nữa ) , xin được bạn giúp tiếp .

Mượn file của Tedaynui và code của Mr OkeBab làm tiếp phần sau cho bạn. Hy vọng bạn OK.

 

[leanhduy]

Mượn file của Tedaynui và code của Mr OkeBab làm tiếp phần sau cho bạn. Hy vọng bạn OK.

file bạn gởi rất hay , tuy nhiên nếu cell nào đó thuộc cột "TT" bị rỗng thì khi trích sang Sheet2 sẽ bị các dòng trích khác (Các dòng có cell cột "TT" không rỗng) sẽ dồn lên thế chỗ dòng này . Vậy cần khắc phục như thế nào ?

 

[ThuNghi]

file bạn gởi rất hay , tuy nhiên nếu cell nào đó thuộc cột "TT" bị rỗng thì khi trích sang Sheet2 sẽ bị các dòng trích khác (Các dòng có cell cột "TT" không rỗng) sẽ dồn lên thế chỗ dòng này . Vậy cần khắc phục như thế nào ?

Bạn thay code sau vào, thông thường các trường dữ liệu không nên để rỗng.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo EndSub
If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
    If Target.Column = 5 Then
        If UCase(Target.Value) = "X" Then
            Application.EnableEvents = False
            Dim iRow1, iRow2 As Integer
            Target.Value = "X"
            iRow1 = Target.Row
            iRow2 = Sheet2.Range("A65000").End(xlUp).Row + 1
            Sheet1.Range("F" & iRow1) = Now()
            Sheet2.Range("A" & iRow2 & ":D" & iRow2).Value = Sheet1.Range("A" & iRow1 & ":D" & iRow1).Value
         ElseIf Target.Value = "" Then
            Application.EnableEvents = False
            Dim TT As Integer
            iRow1 = Target.Row
            iRow2 = Sheet2.Range("B65000").End(xlUp).Row
            Sheet1.Range("F" & iRow1) = ""
            TT = Sheet1.Range("A" & iRow1)
                For i = iRow2 To 2 Step -1
                    If Sheet2.Range("A" & i) = TT Or Sheet2.Range("A" & i) = "" Then
                        Sheet2.Rows("0" & i).Delete Shift:=xlUp
                    End If
                Next i
        End If
    End If
End If
EndSub:
    Application.EnableEvents = True
End Sub