Tự động xóa sau 1 khoảng thời gian nhất định (1 người xem)

toandiennuoc123 · 22/3/12

Trong 1 khoảng thời gian (3s- 5s) nó sẽ tự động xóa ô vừa gõ

ndu96081631 · 22/3/12

toandiennuoc123 đã viết:
Trong 1 khoảng thời gian (3s- 5s) nó sẽ tự động xóa ô vừa gõ

Có vẻ như bạn muốn cộng dồn?
Nếu đã muốn dùng code thì dùng code toàn bộ, bỏ luôn công thức nhé:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim OldVal As Double
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("B2:B15"), Target) Is Nothing Then
    If Target.Count = 1 Then
      OldVal = CDbl(Target.Value)
      Target.Offset(, 1) = Target.Offset(, 1) + OldVal
      Target.ClearContents
    End If
  End If
  Application.EnableEvents = True
End Sub

Vậy cũng không cần canh giờ 3s, 5s gì cả... Cứ nhập cột B, tự cộng dồn sang cột C rồi xóa giá trị vừa nhập luôn

toandiennuoc123 · 22/3/12

Pro ơi , thêm các cột như thế này có được không ?,khi thêm vào thì không dùng được và hiện dòng màu vàng và xanh.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldVal As Double
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("AR20:AR29", "AU20:AU29", "AX20:AX29", "BA19:BA30", "BD19:BD30", "BG16:BG30", "BJ19:BJ22"), Target) Is Nothing Then
If Target.Count = 1 Then
OldVal = CDbl(Target.Value)
Target.Offset(, 1) = Target.Offset(, 1) + OldVal
Target.ClearContents
End If
End If
Application.EnableEvents = True
End Sub

ndu96081631 · 23/3/12

toandiennuoc123 đã viết:
Pro ơi , thêm các cột như thế này có được không ?,khi thêm vào thì không dùng được và hiện dòng màu vàng và xanh.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldVal As Double
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("AR20:AR29", "AU20:AU29", "AX20:AX29", "BA19:BA30", "BD19:BD30", "BG16:BG30", "BJ19:BJ22"), Target) Is Nothing Then
If Target.Count = 1 Then
OldVal = CDbl(Target.Value)
Target.Offset(, 1) = Target.Offset(, 1) + OldVal
Target.ClearContents
End If
End If
Application.EnableEvents = True
End Sub

Tại bạn viết sai thôi
Sửa đoạn:
Range("AR20:AR29", "AU20:AU29", "AX20:AX29", "BA19:BA30", "BD19:BD30", "BG16:BG30", "BJ19:BJ22")
Thành:
Range("AR20:AR29, AU20:AU29, AX20:AX29, BA19:BA30, BD19:BD30, BG16:BG30, BJ19:BJ22")

toandiennuoc123 · 23/3/12

Lại phải hỏi thêm Pro rồi, muốn nhập ở ô AF22 rồi được cộng vào ô T33 thì thay đổi (code) ở đoạn nào?. có khoảng 100 ô như vậy(AF22:AO29)và (T33:AC42).(Vẫn ở cùng 1 Sheet có đoạn "code" trên)

quykh · 23/3/12

Phải vậy không Thầy NDU :Target.Offset(11, -12) = Target.Offset(11, -12) + OldVal

ndu96081631 · 23/3/12

toandiennuoc123 đã viết:
Lại phải hỏi thêm Pro rồi, muốn nhập ở ô AF22 rồi được cộng vào ô T33 thì thay đổi (code) ở đoạn nào?. có khoảng 100 ô như vậy(AF22:AO29)và (T33:AC42).(Vẫn ở cùng 1 Sheet có đoạn "code" trên)

Bạn hãy nêu ra quy luật về khoảng cách giữa cell nhập và cell cộng dồn sẽ có ngay code
Ví dụ code của tôi thì quy luật giữa 2 cell này là cùng dòng, cách nhau 1 cột (nên Offset(, 1)...)

toandiennuoc123 · 23/3/12

Pro xem file đính kèm nhé, nó cũng hơi khó tả

Tường_Vi · 23/3/12

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim OldVal As Double
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("B2:B15"), Target) Is Nothing Then
    If Target.Count = 1 Then
      OldVal = CDbl(Target.Value)
      Target.Offset(, 1) = Target.Offset(, 1) + OldVal
      Target.ClearContents
    End If
  End If
  Application.EnableEvents = True
End Sub

Anh NDU cho em hỏi qua đoạn code trên
1. Application.EnableEvents = False --> ý nghĩa khi thêm dòng này
2. tại sao phải chuyển đổi dữ liệu bằng hàm CDBL

Cám ơn Anh

ndu96081631 · 23/3/12

Tường_Vi đã viết:
PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim OldVal As Double On Error Resume Next Application.EnableEvents = False If Not Intersect(Range("B2:B15"), Target) Is Nothing Then If Target.Count = 1 Then OldVal = CDbl(Target.Value) Target.Offset(, 1) = Target.Offset(, 1) + OldVal Target.ClearContents End If End If Application.EnableEvents = True End Sub

Anh NDU cho em hỏi qua đoạn code trên
1. Application.EnableEvents = False --> ý nghĩa khi thêm dòng này
2. tại sao phải chuyển đổi dữ liệu bằng hàm CDBL

Cám ơn Anh

1> Khi dùng sự kiện Change mà có thay đổi tại chính target thì bắt buộc phải dùng cặp lệnh này (code trên, target bị thay đổi tại dòng Target.ClearContents đấy)... Thử tưởng tượng nếu không có cặp lệnh này thì sẽ phiền phức: Ta gõ vào Target ---> Code làm gì đó và có thay đổi trên Target khiến nó kích hoạt sự kiện Change ---> Code lại làm việc... cứ thế... mãi mãi không ngừng.
Có cặp lệnh này vào rồi, code chỉ làm việc duy nhất 1 lần
2> Nếu người ta gõ vào không phải là số thì sao? Vậy nên kết hợp với On Error Resume Next ở trên, dẫn đến OldVal = CDbl(Target.Value) trong trường hợp này sẽ = 0

ndu96081631 · 23/3/12

toandiennuoc123 đã viết:
Pro xem file đính kèm nhé, nó cũng hơi khó tả

Bố trí lại dữ liệu đi bạn ơi... quy luật tùm lum, cuối cùng cũng gần như là chẳng có quy luật gì cả ---> Code nào mà làm việc nỗi đây?

Ba Tê · 23/3/12

toandiennuoc123 đã viết:
Pro xem file đính kèm nhé, nó cũng hơi khó tả

Nhập vào các ô màu xanh, nhập tầm bậy nó chạy tầm bậy luôn, trừ phi khoá lại các ô không được nhập.

toandiennuoc123 · 24/3/12

Gửi Ba Tê: Sao nó không tự xóa được luôn à? mà phải gõ ô khác trong cùng 1 cặp mới xóa được thế, có thể cho xóa luôn được không.

Ba Tê · 24/3/12

toandiennuoc123 đã viết:
Gửi Ba Tê: Sao nó không tự xóa được luôn à? mà phải gõ ô khác trong cùng 1 cặp mới xóa được thế, có thể cho xóa luôn được không.

Xoá luôn càng dễ, nhưng làm sao biết được mình vừa nhập số mấy vào ô nào?

toandiennuoc123 · 24/3/12

Pro ơi ! Thật khó quá vì nó còn bị những đoạn khác chi phối, có thể ghép 2 đoạn này vào được không ?.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldVal As Double
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
If Target.Count = 1 Then
OldVal = CDbl(Target.Value)
Target.Offset(, 1) = Target.Offset(, 1) + OldVal
Target.ClearContents
End If
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldVal As Double
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("AF20:AO29"), Target) Is Nothing Then
If Target.Count = 1 Then
OldVal = CDbl(Target.Value)
Target.Offset(11, -12) = Target.Offset(11, -12) + OldVal
Target.ClearContents
End If
End If
Application.EnableEvents = True
End Sub

toandiennuoc123 · 24/3/12

Không cần lưu lại ô vừa nhập,quan trọng là cộng dồn và tự xóa (ô màu xanh) khi chuyển sang ô khác

Ba Tê · 24/3/12

toandiennuoc123 đã viết:
Không cần lưu lại ô vừa nhập,quan trọng là cộng dồn và tự xóa (ô màu xanh) khi chuyển sang ô khác

Kiểm tra lại file này xem

Tự động xóa sau 1 khoảng thời gian nhất định (1 người xem)

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

Thành viên thường trực

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Chim non

Huyền thoại GPE

Thành viên thường trực

File đính kèm

Thành viên tiêu biểu

Huyền thoại GPE

Huyền thoại GPE

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên thường trực

Thành viên thường trực

Cạo Rồi Khỏi Gội

File đính kèm

Đếm ngược thời gian