Nhờ các bạn viết thêm Code vào đây (1 người xem)

[toandiennuoc123]

Xin chào ACE trên diễn đàn. Cái file của tôi đang làm dở thì bị cụt không làm được nữa nên nhờ ACE trên diễn đàn giúp đỡ, xem file đính kèm

 

[Quang_Hải]

Code mình viết chạy hoàn hảo chỉ tại bạn không biết gán macro vào cái nút nào cả mới như thế. Lúc đầu bạn yêu cầu viết code theo sự kiện (change), tự nhiên giờ sửa lại thành 1 Sub như thế nếu chạy giống yêu cầu ban đầu được mới lạ nghen. Căn bản là phải kết hợp Sub xử lý và Sub sự kiện

Sub thaycongthuc()
Dim hangden, conlai
Dim arr1(), arr2(), arr3(), i, j
hangden = [BX20:CG29].Value
conlai = [ci20:cr29].Value
ReDim arr1(1 To 10, 1 To 10)
ReDim arr2(1 To 10, 1 To 10)
For i = 1 To 10
    For j = 1 To 10
        If hangden(i, j) > [bq18].Value Then
            arr1(i, j) = [bq18].Value
        Else
            arr1(i, j) = hangden(i, j)
        End If
        If hangden(i, j) > arr1(i, j) Then
            arr2(i, j) = hangden(i, j) - arr1(i, j)
        End If
    Next
Next
[bm20].Resize(10, 10) = arr1
[ci20].Resize(10, 10) = arr2
End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Union([bq18], [BX20:CG29]), Target) Is Nothing Then
    thaycongthuc
End If
End Sub

 

[toandiennuoc123]

Cám ơn bạn nhiều nhé. Bạn giúp mình cái bài "thuctap" nhé.

 

[Quang_Hải]

Cám ơn bạn nhiều nhé. Bạn giúp mình cái bài "thuctap" nhé.

Rất tiếc yêu cầu của bạn vượt quá khả năng của mình. Bạn đợi sự giúp đở của các thành viên khác nghen

 

[Quang_Hải]

Thôi cũng ráng giúp bạn hết khả năng, không biết trúng không nữa

 

[toandiennuoc123]

Thôi cũng ráng giúp bạn hết khả năng, không biết trúng không nữa

Không những trúng mà còn trúng quả đậm nữa. Cám ơn bạn rất nhiều, nhưng vẫn còn 1 vấn đề nữa đó là : đổi "bq18" thành "x18" có được không ? Tôi thay vào nhưng nó không chạy được.

 

[Quang_Hải]

Bạn xem dòng lệnh

If Not Intersect(Union([bq18], [BX20:CG29]), Target) Is Nothing Then
Đổi thành
If Not Intersect(Union([X18], [BX20:CG29]), Target) Is Nothing Then

Chúc thành công

 

[toandiennuoc123]

Cám ơn bạn nhiều nhé, nhưng lại có 1 chút vấn đề nữa là ; các công thức công bình thường trong bảng tính nó lại lúc được lúc không là sao nhỉ ? ở các ô "nhập" xóa đi hoặc thêm vào nó không tự động ở "sổ cái" nữa, bạn xem hộ mình nhé, sau khi nhập dữ liệu vào rồi thì phải nhấn vào sheet"phuognhan2" thì nó mới chạy các sheets "phuongnhan" khác . Chân thành cám ơn bạn nhiều lắm.

 

[Quang_Hải]

1. Bảng tính không ở chế độ tính toán tự động. Bạn chọn Tools > Options > Calculation và chon Automatic
2. Do cách link dữ liệu của bạn giống như tham chiếu lòng vòng >>> nên phải kích hoạt sheet này thì sheet kia mới có dữ liệu và có thể kết quả sẽ không đúng ( mình đoán thế nhưng hỏng dám phát biểu). Dữ liệu của bạn không có nhiều và điều kiện không phức tạp thì dùng công thức sẽ dễ kiểm soát hơn

 

[toandiennuoc123]

Phần này tôi ghép được rồi

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Tem As Variant
If Not Intersect(Target, [AF4:AO13]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(29) = Target.Offset(29) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Target, [AF20:AO29]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(13, -12) = Target.Offset(13, -12) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(, 1) = Target.Offset(, 1) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Union([x18], [BX20:CG29]), Target) Is Nothing Then
book1
End If
End Sub

nhưng còn phần này thì:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Tem As Variant
If Not Intersect(Target, [AF4:AO13]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(29) = Target.Offset(29) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Target, [AF20:AO29]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(13, -12) = Target.Offset(13, -12) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(, 1) = Target.Offset(, 1) + Tem
Target.ClearContents
Application.EnableEvents = True
End If
End Sub


Private Sub Worksheet_Activate()
Dim NV, i, temp, j, jj
Dim arrkq(1 To 10, 1 To 10)
NV = Array("Phuong!", "Toan!", "Tuan!", "Tu!", "Dat!", "KAnh!", "Hoa!", "Giang!", "Lan!", "BaChau!", "NinhBinh!", "Khanh!")
For i = 0 To UBound(NV, 1)
temp = Sheets(NV(i)).[T20:AC29]
For j = 1 To 10
For jj = 1 To 10
arrkq(j, jj) = arrkq(j, jj) + temp(j, jj)
Next
Next
Next
[BX20:CG29] = arrkq
End Sub

Nó không chạy được vì lỗi : Run-time error '9'
Subscipt out ò range
Đọc HELP dịch ra:
Thời gian chạy lỗi '9'
Subscipt trong phạm vi ò


Bạn tham chiếu một phần tử mảng không tồn tại.
Subscript có thể lớn hơn hoặc nhỏ hơn so với phạm vi có thể subscripts, hoặc các mảng có thể không có kích thước được chỉ định tại điểm này trong các ứng dụng. Kiểm tra tuyên bố của các mảng để xác minh các giới hạn trên và dưới. Sử dụng các chức năng UBound và LBound để tình trạng mảng truy cập nếu bạn đang làm việc với mảng đó redimensioned. Nếu chỉ mục được chỉ định như là một biến, kiểm tra chính tả của tên biến.


Bạn tuyên bố một mảng nhưng không xác định số lượng các yếu tố. Ví dụ, mã sau đây gây ra lỗi này: Dim MyArray() như là số nguyên
MyArray(8) = 234 ' nguyên nhân lỗi 9.



Visual Basic ngầm không kích thước mảng không xác định phạm vi như 0-10. Thay vào đó, bạn phải sử dụng Dim hoặc ReDim để xác định một cách rõ ràng số thành phần trong một mảng.


Bạn tham chiếu một thành viên bộ sưu tập không tồn tại.
Thử dùng cho mỗi...Tiếp theo xây dựng thay vì xác định các yếu tố chỉ số


Bạn đã sử dụng một hình thức viết tắt subscript ngầm đã chỉ định một phần tử không hợp lệ.
Ví dụ, khi bạn sử dụng các! nhà điều hành với một bộ sưu tập, các! ngầm chỉ định một khóa. Ví dụ, object!keyname.value là tương đương với object.item (keyname) .value. Trong trường hợp này, một lỗi được tạo ra nếu keyname đại diện cho một khóa không hợp lệ trong bộ sưu tập. Để khắc phục lỗi, sử dụng một tên hợp lệ phím hoặc chỉ số cho bộ sưu tập.

Tôi đọc không hiểu gì hết ?!!!. Rất mong bạn xem hộ. Xin chân thành cám ơn.

 

[Quang_Hải]

Mình đầu hàng cách ghép code của bạn rồi. Mình không dám bàn tiếp. Hy vọng là sẽ có người hiểu được vấn đề và giải quyết vân đề giúp bạn.

 

[toandiennuoc123]

Mình đầu hàng cách ghép code của bạn rồi. Mình không dám bàn tiếp. Hy vọng là sẽ có người hiểu được vấn đề và giải quyết vân đề giúp bạn.

Mình ghép đại như thế thì thấy nó chạy nhanh hơn nhưng lại bị khúc mắc về đoạn code về sau, Đọc HELP thì thấy nó bảo là có vấn đề về mảng "array", cũng rất mong những cao thủ như bạn có thể chỉ giáo, coi như dạy lại cho thế hệ "đàn em" để có thể tiến bộ trong lập trình VBA. Xin chân thành cám ơn bạn rất nhiều.

 

[Quang_Hải]

Mình không thấy bảng tính nên không hiểu được tại sao bạn thay dòng này. Chắc tại cái dấu ! nên code không hiểu

NV = Array("Phuong!", "Toan!", "Tuan!", "Tu!", "Dat!", "KAnh!", "Hoa!", "Giang!", "Lan!", "BaChau!", "NinhBinh!", "Khanh!")

 

[toandiennuoc123]

Mình không thấy bảng tính nên không hiểu được tại sao bạn thay dòng này. Chắc tại cái dấu ! nên code không hiểu

NV = Array("Phuong!", "Toan!", "Tuan!", "Tu!", "Dat!", "KAnh!", "Hoa!", "Giang!", "Lan!", "BaChau!", "NinhBinh!", "Khanh!")

Thêm cái này vào để nghiên cứu thôi , nhưng vẫn không hiểu...Còn cái bảng tính thì bạn vào SheetPhuong nhập vào ô "nhận" rồi vào sheet "Phuongnhan" dưới chữ "Sổ cái" ô X18, nhập số, rồi vào Sheet "Tralai" xem. VD: Chỉ tiêu của "Phuong" là 50, "Phuongnhan" chỉ làm được có 30, còn thừa "Tralai" 20, đấy là cách vào bảng tính. Còn khi kiểm tra lài kết quả thì phải ấn vào các sheet : từ sheet "Tralai" cho đến sheet "Phuongnhan6" thì kết quả mới nhảy số. Có cách nào mà không phải nhấn nhiều sheet như thế không ?.
Ps: Bảng tính di chuyến ngang.

 

[Quang_Hải]

Bạn chèn code này vào 1 module. Tao 1 phím tắt cho marco này. Khi nào cần thì gọi, marco sẽ duyệt lại các sheet để cập nhật dữ liệu. Tạm thời mình chưa có cách nào tốt hơn

Sub duyet_qua_cac_sheet()
Application.ScreenUpdating = False
    Dim sh As Worksheet, Cursheet As Worksheet
        Set Cursheet = ActiveSheet
            For Each sh In Worksheets
                sh.Select
            Next
        Cursheet.Select
Application.ScreenUpdating = True
End Sub

 

[toandiennuoc123]

Bạn chèn code này vào 1 module. Tao 1 phím tắt cho marco này. Khi nào cần thì gọi, marco sẽ duyệt lại các sheet để cập nhật dữ liệu. Tạm thời mình chưa có cách nào tốt hơn

Sub duyet_qua_cac_sheet()
Application.ScreenUpdating = False
    Dim sh As Worksheet, Cursheet As Worksheet
        Set Cursheet = ActiveSheet
            For Each sh In Worksheets
                sh.Select
            Next
        Cursheet.Select
Application.ScreenUpdating = True
End Sub

Cám ơn bạn rất nhiều, thế là lại có 1 bước tiến nữa rồi. Công trình này gần như đã hoàn tất chỉ còn thiếu 1 chút xíu nữa thôi, bạn cố gắng giúp mình nhé.