toandiennuoc123
Thành viên thường trực
- Tham gia
- 7/3/12
- Bài viết
- 239
- Được thích
- 9
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c2]) Is Nothing Then
Dim HangDen, ConLai, Sh As Object
Dim Arr1(), Arr2(), Arr3(), I, J
Set Sh = ThisWorkbook.Worksheets("Sheet1")
HangDen = Sh.[BX20:CG29].Value
ConLai = Sh.[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) > Target.Value Then
Arr1(I, J) = Target.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
Sh.[bm20].Resize(10, 10) = Arr1: Sh.[ci20].Resize(10, 10) = Arr2
End If
Sh.Select: Set Sh = Nothing
End Sub
Cám ơn bạn rất nhiều, tiện thể nhờ bạn xem hộ cái Textbox, khi nhập xong thì Enter là thoát luônPHP:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [c2]) Is Nothing Then Dim HangDen, ConLai, Sh As Object Dim Arr1(), Arr2(), Arr3(), I, J Set Sh = ThisWorkbook.Worksheets("Sheet1") HangDen = Sh.[BX20:CG29].Value ConLai = Sh.[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) > Target.Value Then Arr1(I, J) = Target.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 Sh.[bm20].Resize(10, 10) = Arr1: Sh.[ci20].Resize(10, 10) = Arr2 End If Sh.Select: Set Sh = Nothing End Sub
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2