.Replace What:=oldText, Replacement:=newText, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=FalseOption Explicit
Sub TimVaThayThe()
Dim DiaChi As String 'Sa
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, 4))
Dim oldText As String, newText As String
oldText = "3"
newText = "test"
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
Set Rng = .Find(What:=oldText, After:=ActiveCell,LookIn:=xlValues, LookAt:=xlxlPart)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng.Offset(, 5)
With Rng
.Value = newText
.Interior.ColorIndex = 36
.Font.Bold = True
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
End Sub
Sub TimVaGan()
Dim DiaChi As String, i As Long
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, 4))
Dim oldText As String
Dim MyArr()
i = 1
ReDim MyArr(1 To MyRng.Count)
oldText = "3"
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlPart)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
MyArr(i) = Rng.Value
i = i + 1
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then GoTo bien
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
bien:
With Sheets("sheet2")
.Cells.ClearContents
For i = LBound(MyArr) To UBound(MyArr)
.Cells(i, 1) = MyArr(i)
Next
End With
End Sub
ThuNghi nhờ thì hiệu đính thôi, chứ tuyệt nhiên không có ý định gây áp lực đâu HoangDanh nha
Option Explicit
Sub TimVaThayThe()
Dim DiaChi As String
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, "D"))
' Dim newText As String'
Const oldText As Long = 3
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
.Value = "test": .Font.Bold = True
.Interior.ColorIndex = 36
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
End SubOption Explicit
Sub xIndex()
With Application
.ScreenUpdating = False
End With
Dim DiaChi As String, eRow As Long, iR As Long
Dim MyRng As Range, Rng As Range, RngDM As Range
Dim oldText As String
Sheets("Data").Select
With Sheets("Index")
eRow = .[a1000].End(xlUp).Row - 1
Set RngDM = .Range(.Cells(2, 1), .Cells(eRow, 3))
End With
Columns("B:B").ClearComments
Columns("A:D").ClearFormats
eRow = [a1000].End(xlUp).Row
Range(Cells(2, 3), Cells(eRow, 4)).ClearContents
Set MyRng = Range(Cells(2, 2), Cells(eRow, 2))
For iR = 1 To eRow
oldText = RngDM.Cells(iR)
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
If .Value = "A1" Then
With .Offset(0, -1).Resize(, 4).Font
.ColorIndex = 5
.Bold = True
End With
.AddComment
.Comment.Visible = False
.Comment.Text Text:="GPE:" & Chr(10) & "OK"
End If
.Offset(, 1).Value = RngDM.Cells(iR).Offset(, 1)
With .Offset(, 2)
.Value = RngDM.Cells(iR).Offset(, 2)
.NumberFormat = "#,##0"
End With
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
Next
Set RngDM = Nothing
Set MyRng = Nothing
With Application
.ScreenUpdating = True
End With
End SubTheo ý mình nó như vầy; Nói nhỏ:"Ngoài cách giới thiệu phương thức FIND(), macro này là một điển hình về cách dùng
Option Explicit
Sub xIndex()
Dim DiaChi As String, eRow As Long, jF As Long
Dim MyRng As Range, Rng As Range, RngDM As Range
Dim OldText As String
Application .ScreenUpdating = False
With Sheets("Index")
eRow = .[a1000].End(xlUp).Row - 1
Set RngDM = .Range(.Cells(2, 1), .Cells(eRow, "C"))
End With
Sheets("Data").Select
Columns("B:B").ClearComments
Columns("A:D").ClearFormats: eRow = [a65000].End(xlUp).Row
Range(Cells(2, 3), Cells(eRow, 4)).ClearContents
Set MyRng = Range([B2], Cells(eRow, 2))
For jF = 1 To eRow
OldText = RngDM.Cells(jF)
With MyRng
Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
If .Value = "A1" Then
With .Offset(0, -1).Resize(, 4).Font
.ColorIndex = 5: .Bold = True
End With
.AddComment: .Comment.Visible = False
.Comment.Text Text:="GPE:" & Chr(10) & "OK"
End If
.Offset(, 1).Value = RngDM.Cells(jF).Offset(, 1)
With .Offset(, 2)
.Value = RngDM.Cells(jF).Offset(, 2)
.NumberFormat = "#,##0"
End With
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
Next
Set RngDM = Nothing: Set MyRng = Nothing
End SubWith MyRng
Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
...
End WithSub MyFind()
Dim r As Long, rW As Long, rF1 As Long, rF2 As Long, S As Long
Dim sFind
On Error Resume Next
Columns("B").ClearContents
r = 1
sFind = InputBox("Nhap du lieu tim:")
rF1 = [COLOR=Red][B]Columns("A")[/B][/COLOR].Find(What:=sFind, After:=Cells(1, 1)).Row
If rF1 = 0 Then Exit Sub
rF2 = rF1
Do
Cells(r, 2) = Cells(rF2, 1)
r = r + 1
rF2 = Columns("A").Find(What:=sFind, After:=Cells(rF2, 1)).Row
If rF2 <= rF1 Then Exit Do
Loop
End SubCách của thầy Long cũng như cách khác, đều dùng vòng lặp Do . . . Loop cả mà!
Sub Find_Sun()
Dim lCount As Long '(Ozgrid.com)
Dim rFoundCell As Range
Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Sun")
Set rFoundCell = Columns(1).Find(What:="Sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell.Offset(, 2)
.Value = rFoundCell
.ClearComments
.AddComment Text:="Ozgrid.com"
End With
Next lCount
End Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChiFor lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Sun")Cám ơn lời gợi ý, nhờ vậy mình mới tìm thấy cái hay của find. Các bạn xem thử code sau, tìm trong A, B, C có những cell nào có "ch". Ta chọn thử MyRng là 3 cột A, B, C
Sub Find_CaiGiDo()
Dim lCount As Long '(Ozgrid.com)
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet2.Range(Cells(1, 1), Cells(25, 3))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "*ch*")
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="ch", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
.Value = rFoundCell
.ClearComments
.AddComment Text:="Ozgrid.com"
End With
Next lCount
End SubSearchOrder:=xlByColumns hay là
Đúng là thiếu. Lúc chạy thử đang đã chọn cột A nên nó chạy tốt nhờ Selection.Find ...
rF1 = column(1).Find(What:=sFind, After:=Cells(1, 1)).Row tìm ô đầu tiên thỏa mãn điều kiện tìm thì After:=Cells(1, 1) thừa.
Sub TaoPN()
Dim iRow As Long, EndR As Long
Dim MyRng As Range, rFoundCell As Range, SoCT As String
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Sheets("PhNK").Select
[a14:i27].ClearContents
[C6:C8].ClearContents
SoCT = [H5]
With Sheets("BKNhap")
EndR = .[a65000].End(xlUp).Row
Set MyRng = .Range(.Cells(1, 5), .Cells(EndR, 5)) 'Sửa 2 thành 1'
EndR = WorksheetFunction.CountIf(MyRng, SoCT)
Set rFoundCell = MyRng(1)
Set rFoundCell = MyRng.Find(What:=SoCT, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
With rFoundCell
Cells(4, 4) = .Offset(iRow, -4).Value
Cells(6, 3) = .Offset(iRow, 1).Value
Cells(8, 3) = "Nhap theo HD" & .Offset(iRow, -1).Value
For iRow = 0 To EndR - 1
Cells(iRow + 14, 1) = iRow + 1
Cells(iRow + 14, 2) = .Offset(iRow, 2).Value
Cells(iRow + 14, 3) = .Offset(iRow, 3).Value
Cells(iRow + 14, 4) = .Offset(iRow, 7).Value
Cells(iRow + 14, 6) = .Offset(iRow, 4).Value
Cells(iRow + 14, 7) = .Offset(iRow, 5).Value
Cells(iRow + 14, 8) = .Offset(iRow, 6).Value
Cells(iRow + 14, 9) = "HD" & .Offset(iRow, -1).Value
Next
End With
End With
Set MyRng = Nothing
Set rFoundCell = Nothing
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End SubSub Find_Format1()
Dim lCount As Long
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet1.Range(Cells(1, 1), Cells(50, 1))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "sun")
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
If .Font.Bold = True And .Font.ColorIndex = 3 Then
.AddComment Text:="TN"
End If
End With
Next lCount
End Sub
Sub Find_Format()
Dim lCount As Long
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet1.Range(Cells(1, 1), Cells(50, 1))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "sun")
With Application.FindFormat.Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, searchFormat:=True)
On Error Resume Next
With rFoundCell
.AddComment Text:="Tim thay roi TN oi!"
End With
Next lCount
End Sub
Set Rng = Selection.Find("*1*", LookIn:=xlValues, LookAt:=xlWhole)expression: Required. An expression that returns a Range object.
Cells.Find(What:="SUN", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).ActivateSub TestFind()
With Worksheets("Sheet1").Range("A1:A500")
Set Rng = .Find(2, LookIn:=xlValues)
If Not Rng Is Nothing Then ‘Nếu giá trị Rng trả về không phải là Nothing thì
firstAddress = Rng.Address ‘Lưu lại địa chỉ ô đầu tiên tìm được.
Do
Rng.Value = 5
Set Rng = .FindNext(Rng) ‘Tìm tiếp
Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
‘Dừng vòng lặp Do..Loop khi giá trị Rng trả về là Nothing hoặc
‘địa chỉ Rng trả về trùng với địa chỉ của ô tìm được đầu tiên.
End If
End With
End SubSub FindCatOtherSheet()
Dim rFound As Range
On Error Resume Next
With Sheet1
Set rFound = .Columns(1).Find(What:="Cat", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False , _
SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then Application.Goto rFound, True
End WithSub Find_Bold_Cat()
Dim lCount As Long
Dim rFoundCell As Range
Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Cat")
Set rFoundCell = Columns(1).Find(What:="Cat", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
.ClearComments
.AddComment Text:="Cat lives here"
End With
Next lCount
End SubFor Each Rng In [A1:C5]
If Rng.Font.Name Like "Cour*" Then
Rng.Font.Name = "Times New Roman"
End If
Next Cells.Find(What:="SUN", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).ActivateTôi thêm vào để cho bình dân hóa.
Sub Find_Bold_Cat()
Dim lCount As Long
Dim rFoundCell As Range
Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Cat")
Set rFoundCell = Columns(1).Find(What:="Cat", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
.ClearComments
.AddComment Text:="Cat lives here"
End With
Next lCount
End SubĐếm tất cả các Cell trong cột 1 có giá trị là ký tự Cat (toàn bộ Cell)
Tìm tất cả các Cell trong cột 1 có chứa ký tự Cat (Một phần Cell)
Chúng ta đang xét đến việc tìm trên 1 cột; Nếu ta thực hiện việc này trong lệnh của menu ta sẽ thấy excel tìm từ đầu cho đến cuối vùng (VD ta đã kích hoạt vùng từ 'A1:A500')
Loop While Not Rng Is Nothing And Rng.Address <> firstAddressTheo tôi nghĩ là chưa chính xác.
If Not Intersect(Target, [b3]) Is Nothing Then
'Đoạn mã Mới:'
Dim MyDir As String, KhTiep As Boolean
If Not IsNumeric(Target.Value) Then
MsgBox "Khong Fai Só Tu Nhien": Exit Sub
End If
If Target.Value <= 0 Then
MyDir = "Só Quá Bé!": KhTiep = True
End If
If Int(Target.Value) < Target.Value Then
MyDir = "Khong Chap Nhan Só Thap Fan!": KhTiep = True
End If
If KhTiep Then
MsgBox MyDir: Exit Sub
End If
'* * * * * *'
Dim Rng As Range, sRng As Range, Rg0 As Range
Dim MyAdd As String '<=| Dòng Lenh Này Da Duoc Sua Lại'
Dim Jj As Byte
À mình đang nói tới code #3 của ThuNghi.
Option Explicit
Sub TimVaThayThe()
Dim OldText As String, NewText As String, DiaChi As String 'Sa'
Dim MyRng As Range, Rng As Range
1 Set MyRng = Range(Cells(1, 1), Cells(18, 4))
OldText = "3": NewText = "test"
With MyRng
2 Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole)
3 If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng.Offset(, 5)
5 ' With Rng <=| Khong Càn Dòng Này'
.Value = NewText
.Interior.ColorIndex = 36
.Font.Bold = True
End With
Set Rng = .FindNext(Rng)
7 ' If Rng Is Nothing Then Exit Sub <=| Khong Càn Dòng Này'
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
9 End If
End With
End Sub1 Set MyRng = Cells(1, 1).CurrentRegion2 Set Rng = .Find(OldText, , xlValues, xlWhole)3 If Not Rng Is Nothing Then
'. . . . . '
Else
Exit Sub
9 End If
Thanks bạn nhen.[ThongBao](2) À mình đang nói tới code #3 của ThuNghi.
(1) Nhân tiện mình đang có một vấn đề:
Mình có một danh sách các khế ước vay. Mình đang muốn viết một code để tìm xem có khế ước vay mới nào phát sinh thêm không (chưa có trong danh sách khế ước đã có) -> Nếu có thì copy khế ước đó vào dòng tiếp theo của danh sách khế ước cũ (chỉ copy một lần đối với mỗi khế ước mới). Mong các bạn chỉ giúp, mình rất gà về VBA.[/ThongBao]
(1) Bạn nên đưa file giả lập lên; Cũng nhiều người lười biếng làm file giả lập cho bạn lắm đấy!
(2) Bạn lấy cái ni thay thế:
PHP:Option Explicit Sub TimVaThayThe() Dim OldText As String, NewText As String, DiaChi As String 'Sa' Dim MyRng As Range, Rng As Range 1 Set MyRng = Range(Cells(1, 1), Cells(18, 4)) OldText = "3": NewText = "test" With MyRng 2 Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole) 3 If Not Rng Is Nothing Then DiaChi = Rng.Address Do With Rng.Offset(, 5) 5 ' With Rng <=| Khong Càn Dòng Này' .Value = NewText .Interior.ColorIndex = 36 .Font.Bold = True End With Set Rng = .FindNext(Rng) 7 ' If Rng Is Nothing Then Exit Sub <=| Khong Càn Dòng Này' Loop While Not Rng Is Nothing And Rng.Address <> DiaChi 9 End If End With End Sub
Với những ghi chú thêm như sau:
a./ Câu lệnh mang số 1 có thể thay bằng câu lệnh:
Mã:1 Set MyRng = Cells(1, 1).CurrentRegion
Tương tự như vậy câu lệnh mang số 2 sẽ có thể là:
Mã:2 Set Rng = .Find(OldText, , xlValues, xlWhole)
b./ Câu lệnh mang số 5 là dư hẵn; Để tránh sai sót này, những nhà lập trình amatơ nên thụt đầu dòng các khối lệnh thẳng cột
C./ Câu lệnh mang số 7 cũng dư thừa không cần thiết;
Điều này rõ hơn khi ta xem khối lệnh điều kiện từ dòng lệnh mang số 3 đến dòng lệnh mang số 9; Trong điều kiện này thì không thể nào sẩy ra trường hợp để thực thi dòng lệnh dư này; Nó chỉ để đó như ngồi chơi xơi nước mà thôi.
Muốn viết làm nó có tác dụng thực tế ta fải viết vầy:
Mã:3 If Not Rng Is Nothing Then '. . . . . ' Else Exit Sub 9 End If
(Rồi sau này bạn sẽ biết, rằng cũng chả nhứt thiết fải xài bổ sung nó làm chi!)
Thân.
) )Sub Teting()Dim x As IntegerWorksheets ("Sheet1").SelectFor x = 1 To 100If Range ("C"&x).Value>0 Then Range ("C"&x).Copy Range("D"&x)Else Exit ForEnd IfNext xEnd Sub
Nhân tiện đây các bạn cho mình hỏi cái code sau của mình sao nó không chạy đuoc voi. Mình muốn kiểm tra các giá trị tại cột C,nếu >0 thì copy giá trị đó sang một vị trí khác, ở đây là cột D tương ứng. (mình ko copy code vào đây được
Sub Teting()
Dim x As Integer
Worksheets ("Sheet1").Select
For x = 1 To 100
If Range ("C"&x).Value>0 Then
Range ("C"&x).Copy Range("D"&x)
Else
Exit For
End If
Next x
End Sub
Sub Teting()
Dim x As Integer
Worksheets ("Sheet1").Select
For x = 1 To 100
If Range ("C"&x).Value>0 Then
Range ("C"&x).Copy Range("D"&x)
[B][COLOR=#ff0000]Else
Exit For[/COLOR][/B]
End If
Next x
End SubLoop While Not Rng Is Nothing And Rng.Address <> DiaChiSet Rng = .FindNext(Rng)Sub Update()
Dim SaveRg As Range, Cl As Range, Tm, i
Tm = Application.InputBox("Chon vung DL moi PS:(3 cot: Khe uoc-Tien Vay-Tien tra)", "CHON DU LIEU UPDATE", , , , , , 64)
For i = 1 To UBound(Tm, 1)
Set SaveRg = Sheet2.Range("A2:A" & Sheet2.Cells(Rows.Count, 1).End(3).Row)
Set Cl = SaveRg.Find(what:=Tm(i, 1))
If Cl Is Nothing Then
Sheet2.Cells(SaveRg.Rows.Count + 2, 3) = Tm(i, 3)
Sheet2.Cells(SaveRg.Rows.Count + 2, 2) = Tm(i, 2)
Sheet2.Cells(SaveRg.Rows.Count + 2, 1) = IIf(IsNumeric(Tm(i, 1)), "'" & Tm(i, 1), Tm(i, 1))
Else
Cl.Offset(, 1) = Cl.Offset(, 1) + Tm(i, 2)
Cl.Offset(, 2) = Cl.Offset(, 2) + Tm(i, 3)
End If
Next
End SubBạn ơi vui lòng giải thích cái macro trên giúp mình được không.
3 cot: Khe uoc-Tien Vay-Tien tra)", "CHON DU LIEU UPDATE", , , , , , 64)
Lỗi là phải rồi. Bạn khai Tm là Range đối tượng sau đó thì gán Tm = ...
Sub Test()
Dim [COLOR=#ff0000]Tm As Range[/COLOR]
With Sheets("Input").Range("A4")
.AutoFilter Field:=1, Criteria1:="nh10"
[COLOR=#ff0000] Set Tm = .Parent.AutoFilter.Range[/COLOR]
End With
End SubCái đó chưa chắc nha!
With SaveRg
[FONT=arial].Range("A" & ER + 1).Formula = "'" & Mang_DL(i, 2)
.Range("B" & ER + 1).Value = Application.SumIf(.Range("Khe_uoc"), .Range("A" & ER + 1), .Range("So_vay"))
.Range("C" & ER + 1).Value = Application.SumIf(.Range("Khe_uoc"), .Range("A" & ER + 1), .Range("So_tra"))
.Range("D" & ER + 1).Value = Application.Sum(.Range("B" & ER + 1), -.Range("C" & ER + 1))[/FONT]
End With
