Giải pháp Nhập Cộng dồn cho 1 Vùng

[tigertiger]

Vấn đề này đã bàn 1 lần tại:
http://www.giaiphapexcel.com/forum/showthread.php?p=49056#post49056

Nhưng tigertiger thấy, đấy là vấn đề rất hay, Xin mở 1 topic để mạn đàm, mong nhận được góp ý

+ Và tigertiger đã có giải pháp cho phép nhập cộng dồn trên 1 vùng (cho phép nhập giá trị từng ô hoặc đồng thời nhiều ô Ctrl+Enter) -
+ Vùng DL được định nghĩa qua Name -> không giới hạn về vị trí cũng như ko phải mặc định số hàng số cột. -> và có thể chèn hàng chèn cột dịch chuyển vùng DL

hạn chế : chắc là do sd sự kiện Workbook_open
+ Tuy nhiên khi định nghĩa name này (VungNhap) cho vùng mới thì sau khi định nghĩa phải đóng file lại và thoát khỏi Excel -> mở lại là được
+ tương tự cho việc chèn thêm hàng/ cột vào giữa vùng nhập thì cũng phải đóng file lại thoát khỏi excel và mở lại

Code:

Option Explicit
 Dim oldValue()
 Dim Rgn As Range
 Dim nR As Integer, nC As Integer, sR As Integer, sC As Integer 'sR startRow, sC startColumn
Private Sub Workbook_Open()
    Set Rgn = Range("VungNhap")
    nR = Rgn.Rows.Count: nC = Rgn.Columns.Count: ReDim oldValue(nR, nC)
    sR = Rgn.Row: sC = Rgn.Column
    Dim cE As Range
    For Each cE In Rgn
        oldValue(cE.Row - sR + 1, cE.Column - sC + 1) = Rgn(cE.Row - sR + 1, cE.Column - sC + 1).Value
    Next
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Intersect(Range("VungNhap"), Target) Is Nothing Then
     Application.EnableEvents = False
     sR = Rgn.Row: sC = Rgn.Column
     Dim cE As Range
     For Each cE In Target
        Rgn(cE.Row - sR + 1, cE.Column - sC + 1).Value = Rgn(cE.Row - sR + 1, cE.Column - sC + 1).Value + oldValue(cE.Row - sR + 1, cE.Column - sC + 1)
        oldValue(cE.Row - sR + 1, cE.Column - sC + 1) = Rgn(cE.Row - sR + 1, cE.Column - sC + 1).Value
     Next
     Application.EnableEvents = True
  End If
End Sub

Trong đó VungNhap là name định nghĩa cho Vùng nhập

Alt+F11 -> chọn ThisWorkbook (ở lề trái) -> rồi dán code trên vào; & định nghĩa Vung nhập thành 1 name VungNhap là OK

xin xem File gửi kèm

 

[SA_DQ]

Mình có giải pháp cộng 1 cột giá trị với 1 hằng số, rất mong các bạn góp í!

Đầu tiên mình khai báo các biến dùng chung tại module 1

Public Mang
Public Rng As Range
Public lRow As Long, iCol As Integer

Và dùng các thủ tục sự kiện:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   lRow = Target.Rows.Count:        iCol = Target.Columns.Count
 If lRow > 1 And iCol = 1 Then
    Set Rng = Target:               Mang = Rng
 End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error Resume Next
 Dim lJ As Long, Clls As Range
 Application.EnableEvents = False
 For Each Clls In Target
    lJ = lJ + 1
    Clls = Mang(lJ, 1) + Clls
 Next Clls
 Application.EnableEvents = True
End Sub

Theo mình nghỉ, đoạn mã này có ứng dụng trong thực tiển, sau khi các bạn góp í & hoàn chỉnh!

 

[voda]

Nguyên văn bởi tigertiger
Nhưng tigertiger thấy, đấy là vấn đề rất hay, Xin mở 1 topic để mạn đàm, mong nhận được góp ý

Mình cũng thấy vấn đề này rất hấp dẫn, chưa kịp thử thì tigertiger đã làm rồi và mở topic mới. Mình mong được trao đổi và học tập với bạn. Sau đây là hướng xử lý của mình, có hơi khác một chút, post lên để mạn đàm cho vui:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Integer, j As Integer
If Not Intersect(Range("VungNhap"), Target) Is Nothing Then
sR = Rgn.Row: sC = Rgn.Column
Application.EnableEvents = False
i = Target.Row - sR + 1
j = Target.Column - sC + 1
oldValue(i, j) = oldValue(i, j) + Target.Value
Target = oldValue(i, j)
Application.EnableEvents = True
End If
End Sub