Dán đoạn code đó vào bảng tính excel, chọn toàn bộ, nhấn ctrl+H
Là không xoá được ghi chú hay là dán xong code không chạy bạn có thể nói rõ hơn để trao đổi tiếp.
Sub baocaotonghop()
If Range("c3") = "" Or Range("c4") = "" Then
Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text51") & """,2)")
Else
Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text55") & """,2)")
Sheets("data").Range("FN1:FV50000").ClearContents
Sheets("data").Range("F1:N50000").AdvancedFilter 2, Sheets("data").Range("FK2:FK3"), Sheets("data").Range("FN1")
Dim Dic As Object, objmatch As Object
Dim TmpArr, tmp, Item, ArrSource, ArrResult(1 To 50, 1 To 2), strResult$
Dim i&, j&, n&, TenHang$, Sluong&
Set Dic = CreateObject("scripting.dictionary")
ArrSource = Sheets("data").Range("FV2:FV50000")
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = ",*(.+?)\[\s*(\d+)\s*\]"
For i = 1 To UBound(ArrSource, 1)
tmp = ArrSource(i, 1)
If .test(tmp) Then
Set objmatch = .Execute(tmp)
For Each Item In objmatch
TenHang = Application.Trim(Item.submatches(0))
Sluong = Val(Item.submatches(1))
If Not Dic.exists(TenHang) Then
j = j + 1
Dic.Add TenHang, j
ArrResult(j, 1) = TenHang
ArrResult(j, 2) = Sluong
Else
n = Dic.Item(TenHang)
ArrResult(n, 2) = Sluong + ArrResult(n, 2)
End If
Next
End If
Next
End With
For i = 1 To j
strResult = strResult & ArrResult(i, 1) & vbTab & ArrResult(i, 2) & vbLf
Next
Sheets("data").Range("FX2").Resize(1500, 2) = ArrResult
Sheets("data").Range("HC2").Resize(1500, 2) = ArrResult
Set Dic = Nothing
Range("e12").Value = Sheets("data").Range("FL15")
Range("e13").Value = Sheets("data").Range("FL16")
Range("e14").Value = Sheets("data").Range("FL17")
Range("e15").Value = Sheets("data").Range("FL18")
Range("E16").Value = Sheets("data").Range("FL19")
Range("C8").Value = Sheets("data").Range("FL14")
Range("C9").Value = Sheets("thuchi").Range("S3")
Range("F9").Value = Sheets("thuchi").Range("S4")
Range("F8").Value = Sheets("nhap kho").Range("U8")
Range("C10").Value = Range("c8") + Range("c9")
Range("F10").Value = Range("f8") + Range("f9")
Range("E17").Value = Range("c8").Value
Range("C3").Select
Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text52") & """,2)")
End If
End SubCách này của bác nếu có code tham chiếu đến file excel khác sử dụng dấu ' thì dòng đó sẽ bị xóa.
OK, Thay thế ký tự trực tiếp '* là làm theo bài này, nếu code khác sẽ phải dùng nhóm ký tự ( trong đó có chứa '* ) tùy theo bài cụ thể.
Sub test()
'*
'
'test
' ok
Debug.Print "'" '''
Debug.Print "'''''" '""
Debug.Print "'C:\$'" '"""
'" --"
End SubSub test()
Debug.Print "'"
Debug.Print "'"
Debug.Print "'C:\$"
End SubOption Explicit
Sub Macro1()
Dim n As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim LineText As String
Dim ExitString As String
Dim Quotes As Long
Dim q As Long
Dim StartPos As Long
For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
With ActiveWorkbook.VBProject.VBComponents(i).CodeModule
For j = .CountOfLines To 1 Step -1
LineText = Trim(.Lines(j, 1))
If LineText = "ExitString = " & _
"""" & "Ignore Comments In This Module" & """" Then
Exit For
End If
StartPos = 1
Retry:
n = InStr(StartPos, LineText, "'")
q = InStr(StartPos, LineText, """")
Quotes = 0
If q < n Then
For l = 1 To n
If Mid(LineText, l, 1) = """" Then
Quotes = Quotes + 1
End If
Next l
End If
If Quotes = Application.WorksheetFunction.Odd(Quotes) Then
StartPos = n + 1
Goto Retry:
Else
Select Case n
Case Is = 0
Case Is = 1
.DeleteLines j, 1
Case Is > 1
.ReplaceLine j, Left(LineText, n - 1)
End Select
End If
Next j
End With
Next i
ExitString = "Ignore Comments In This Module"
End Subhttp://www.vbaexpress.com/kb/getarticle.php?kb_id=266
