Cần giúp đỡ cách cộng dồn các ô (1 người xem)

[ufo_910]

Các bác giúp em cái này với
Em muốn lập 1 cái hàm cộng dồn ở ô A2, mà khi em gõ số vào ô A1 thì ô A2 sẽ là kết quả của ô A2 cũ cộng vs ô A1
ở trong pascal thì chỉ việc gõ a:= a+b là xong
nhưng trong excel thì em chả biết nó là hàm gì nữa
có bác nào biết thì chỉ giáo dùm em nhé
Xin đa tạ các bác

 

[nghiaphuc]

Các bác giúp em cái này với
Em muốn lập 1 cái hàm cộng dồn ở ô A2, mà khi em gõ số vào ô A1 thì ô A2 sẽ là kết quả của ô A2 cũ cộng vs ô A1
ở trong pascal thì chỉ việc gõ a:= a+b là xong
nhưng trong excel thì em chả biết nó là hàm gì nữa
có bác nào biết thì chỉ giáo dùm em nhé
Xin đa tạ các bác

Yêu cầu này thì hàm trong Excel bó tay. Chắc chắn là bị lỗi tham chiếu vòng (Circular Reference), giống như tự túm tóc mình mà nhấc bổng mình lên vậy đó.
Tuy nhiên, chúng ta có thể nhờ anh chàng VBA giải quyết. Bạn thử code sau nhé:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Or Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    Target.Offset(, 1) = Target.Offset(, 1) + Target
End Sub

 

[Lê Duy Thương]

Yêu cầu này thì hàm trong Excel bó tay. Chắc chắn là bị lỗi tham chiếu vòng (Circular Reference), giống như tự túm tóc mình mà nhấc bổng mình lên vậy đó.
Tuy nhiên, chúng ta có thể nhờ anh chàng VBA giải quyết. Bạn thử code sau nhé:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Or Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    Target.Offset(, 1) = Target.Offset(, 1) + Target
End Sub

XIN GÓP THÊM MỘT ĐOẠN CỦA LÃO SU PHỤ GPE

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1:A200]) Is Nothing Then
   With Target.Offset(, 1)
     .Value = .Value + Target.Value
      End With
    End If
End Sub

 

[ndu96081631]

Các bạn dùng sự kiện Worksheet_Change xin lưu ý vài điều:
- Code phải có tác dụng khi copy/paste nhiều cell ---> Người ta nhập 10 cell liên tiếp giống nhau thì đương nhiên người ta muốn copy/paste cho lẹ. Chẳng lẽ bắt người ta nhập từng cell?
- Code phải "né" được lỗi trong trường hợp chèn, xóa dòng
vân vân và vân vân...

 

[nghiaphuc]

Các bạn dùng sự kiện Worksheet_Change xin lưu ý vài điều:
- Code phải có tác dụng khi copy/paste nhiều cell ---> Người ta nhập 10 cell liên tiếp giống nhau thì đương nhiên người ta muốn copy/paste cho lẹ. Chẳng lẽ bắt người ta nhập từng cell?
- Code phải "né" được lỗi trong trường hợp chèn, xóa dòng
vân vân và vân vân...

Vậy thì sửa code như vầy được không anh?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    If Target.Column > 1 Then Exit Sub
    On Error Resume Next
    For Each Cll In Intersect(Target, [A:A])
        If Cll <> "" And IsNumeric(Cll) Then Cll.Offset(, 1) = Cll.Offset(, 1) + Cll
    Next
End Sub

 

[ndu96081631]

Vậy thì sửa code như vầy được không anh?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    If Target.Column > 1 Then Exit Sub
    On Error Resume Next
    For Each Cll In Intersect(Target, [A:A])
        If Cll <> "" And IsNumeric(Cll) Then Cll.Offset(, 1) = Cll.Offset(, 1) + Cll
    Next
End Sub

Thế... khỏi For.. Next có được không?
Ẹc... Ẹc... đố biết!

 

[TrungChinhs]

Thế... khỏi For.. Next có được không?
Ẹc... Ẹc... đố biết!

Thế này có được không bạn

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, [A:A]) Is Nothing Then
        Target(1, 2) = Target(1, 2) + Target
    End If
End Sub

 

[ndu96081631]

Thế này có được không bạn

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, [A:A]) Is Nothing Then
        Target(1, 2) = Target(1, 2) + Target
    End If
End Sub

Nhưng code của anh chỉ xài được cho trường hợp nhập liệu từng cell thôi ---> Copy/Paste nhiều cell thì đâu có ăn thua

 

[nghiaphuc]

Thế... khỏi For.. Next có được không?
Ẹc... Ẹc... đố biết!

Em nghĩ đến cái này, nhưng dở ẹc à:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    Intersect(Target, [A:A]).Copy
    Intersect(Target, [A:A]).Offset(, 1).PasteSpecial Operation:=xlAdd
    Application.CutCopyMode = False
    [A65536].End(xlUp).Offset(1).Select
End Sub

Xin bác cho cao kiến cho bài toán này đi!

 

[ndu96081631]

Em nghĩ đến cái này, nhưng dở ẹc à:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 Then Exit Sub
    Intersect(Target, [A:A]).Copy
    Intersect(Target, [A:A]).Offset(, 1).PasteSpecial Operation:=xlAdd
    Application.CutCopyMode = False
    [A65536].End(xlUp).Offset(1).Select
End Sub

Xin bác cho cao kiến cho bài toán này đi!

Cũng có 1 cách khác như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
    With Intersect(Range("A1:A100"), Target)
      .Offset(, 1).Value = Evaluate(.Offset(, 1).Address & "+" & .Address)
    End With
  End If
End Sub

Nhưng dám bảo đảm rằng nó chẳng hay hơn cách PasteSpecial\Values, Add của bạn đâu ---> Vì thế bạn đừng vội cho rằng nó dở ẹc. Ít nhất, phương pháp PasteSpecial\Values, Add chẳng hề bị bất cứ lỗi gì khi gặp giá trị cell thuộc dạng chuổi
Ẹc... Ẹc...

 

[nghiaphuc]

Cũng có 1 cách khác như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
With Intersect(Range("A1:A100"), Target)
.Offset(, 1).Value = Evaluate(.Offset(, 1).Address & "+" & .Address)
End With
End If
End Sub

Nhưng dám bảo đảm rằng nó chẳng hay hơn cách PasteSpecial\Values, Add của bạn đâu ---> Vì thế bạn đừng vội cho rằng nó dở ẹc. Ít nhất, phương pháp PasteSpecial\Values, Add chẳng hề bị bất cứ lỗi gì khi gặp giá trị cell thuộc dạng chuổi
Ẹc... Ẹc...

Cái anh chàng Evaluate này hay thiệt. Chắc em phải xem lại chữ ký của mình thôi.
Cách của anh chạy rất ngon lành nếu dữ liệu dán vào là số, nhưng nếu là chuỗi thì ... tèo đời. Liệu có thể dùng bẫy lỗi để xử vụ này không anh?

 

[ndu96081631]

Cái anh chàng Evaluate này hay thiệt. Chắc em phải xem lại chữ ký của mình thôi.
Cách của anh chạy rất ngon lành nếu dữ liệu dán vào là số, nhưng nếu là chuỗi thì ... tèo đời. Liệu có thể dùng bẫy lỗi để xử vụ này không anh?

Thì bạn dùng SpecialCells để xác định cell lỗi, sau đó gán nó giá trị bằng chính cell bên trái là xong chứ gì
Ví dụ thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
    With Intersect(Range("A1:A100"), Target)
      .Offset(, 1).Value = Evaluate(.Offset(, 1).Address & "+" & .Address)
      .Offset(, 1).SpecialCells(2, 16).Value = "=RC[-1]"
      .Value = .Value
    End With
  End If
  Application.EnableEvents = True
End Sub

Nói chung đây chỉ là giải pháp mang tính chất nghiên cứu code là chính. Nếu là tôi thì tôi sẽ dùng mảng cho trường hợp dữ liệu nhiều

 

[nghiaphuc]

Thì bạn dùng SpecialCells để xác định cell lỗi, sau đó gán nó giá trị bằng chính cell bên trái là xong chứ gì
Ví dụ thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
With Intersect(Range("A1:A100"), Target)
.Offset(, 1).Value = Evaluate(.Offset(, 1).Address & "+" & .Address)
.Offset(, 1).SpecialCells(2, 16).Value = "=RC[-1]"
.Value = .Value
End With
End If
Application.EnableEvents = True
End Sub

Nói chung đây chỉ là giải pháp mang tính chất nghiên cứu code là chính. Nếu là tôi thì tôi sẽ dùng mảng cho trường hợp dữ liệu nhiều

Em thử nhập A1="a" --> B1="a". Tiếp theo, nhập A1=3 --> kết quả B1=6. Như vậy là sai!
Tiếp theo, nhập lại A1="b" --> kết quả B1="b". Như vậy lại sai nữa! Đúng ra thì trong trường hợp này, kết quả tại B1 không được thay đổi (giống như cách PasteSpecial xlValues, xlAdd vậy đó).

 

[ndu96081631]

Em thử nhập A1="a" --> B1="a". Tiếp theo, nhập A1=3 --> kết quả B1=6. Như vậy là sai!
Tiếp theo, nhập lại A1="b" --> kết quả B1="b". Như vậy lại sai nữa! Đúng ra thì trong trường hợp này, kết quả tại B1 không được thay đổi (giống như cách PasteSpecial xlValues, xlAdd vậy đó).

Thì tôi cũng nói trước là thí nghiệm chơi thôi chứ chắc chẳng có code nào ngon hơn PasteSpecial xlValues, xlAdd của bạn đâu