Làm sao xóa tất cả các Comment trong VBA (1 người xem)

congnguyen88 · 12/10/14

Lúc đầu mình ghi chú có gì xem lại thì hiểu đoạn code đó là gì, bầy giờ mình không muốn có các đoạn ghi chú ( màu xanh lá cây ) đó nữa thì xóa thủ công rất là lâu. có cách nào xóa tất cả không. Mong anh em nhiệt tình giúp đở

gtri · 12/10/14

congnguyen88 đã viết:
Lúc đầu mình ghi chú có gì xem lại thì hiểu đoạn code đó là gì, bầy giờ mình không muốn có các đoạn ghi chú ( màu xanh lá cây ) đó nữa thì xóa thủ công rất là lâu. có cách nào xóa tất cả không. Mong anh em nhiệt tình giúp đở

Dán đoạn code đó vào bảng tính excel, chọn toàn bộ, nhấn ctrl+H
find what ='*
nhấn replace all
Sau đó chọn toàn bộ bên bảng tính dán ngược lại vào modul

congnguyen88 · 12/10/14

gtri đã viết:
Dán đoạn code đó vào bảng tính excel, chọn toàn bộ, nhấn ctrl+H
find what ='*
nhấn replace all
Sau đó chọn toàn bộ bên bảng tính dán ngược lại vào modul

kHÔNG được rồi bạn ak. mình đưa cho đoạn code này bạn thử làm xem có được không nha

Sub baocaotonghop()

If Range("c3") = "" Or Range("c4") = "" Then
Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text51") & """,2)")
Else
Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text55") & """,2)")
' loc du lieu ben sheet data
Sheets("data").Range("FN1:FV50000").ClearContents
Sheets("data").Range("F1:N50000").AdvancedFilter 2, Sheets("data").Range("FK2:FK3"), Sheets("data").Range("FN1")

' tach so luong va ten hang ra
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") ' input
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 ' output
Sheets("data").Range("HC2").Resize(1500, 2) = ArrResult
Set Dic = Nothing

' thong ke nhieu nhat, thap nhat lay ben sheet data
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") ' tien ban hang
Range("C9").Value = Sheets("thuchi").Range("S3") ' tien phieu thu
Range("F9").Value = Sheets("thuchi").Range("S4") ' tien phieu chi
Range("F8").Value = Sheets("nhap kho").Range("U8") ' tien nhapkho
Range("C10").Value = Range("c8") + Range("c9") ' tong cong thu
Range("F10").Value = Range("f8") + Range("f9") ' tong cong chi
Range("E17").Value = Range("c8").Value ' doanh thu

Range("C3").Select

Application.ExecuteExcel4Macro ("ALERT(""" & Evaluate("text52") & """,2)")
End If
End Sub

gtri · 12/10/14

congnguyen88 đã viết:
kHÔNG được rồi bạn ak. mình đưa cho đoạn code này bạn thử làm xem có được không nha

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.
Bình thường tôi cũng hay dùng cách này.
Bạn kiểm tra cái này xem sao

PHP:

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 Sub

Hau151978 · 12/10/14

gtri đã viết:
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.
Bình thường tôi cũng hay dùng cách này.
Bạn kiểm tra cái này xem sao

Cá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.

congnguyen88 · 12/10/14

Ok mình làm được rồi. Thank ban nha

gtri · 12/10/14

Hau151978 đã viết:
Cá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ể.

kuldokk · 13/10/14

congnguyen88 đã viết:
Lúc đầu mình ghi chú có gì xem lại thì hiểu đoạn code đó là gì, bầy giờ mình không muốn có các đoạn ghi chú ( màu xanh lá cây ) đó nữa thì xóa thủ công rất là lâu. có cách nào xóa tất cả không. Mong anh em nhiệt tình giúp đở

Để ai có nhu cầu cần xoá comment lần sau:

Code có comments:

PHP:

Sub test()
    '*
   '
   'test
   ' ok
   Debug.Print "'"  '''
   Debug.Print "'''''" '""
   Debug.Print "'C:\$'" '"""
   '" --"
End Sub

Sau khi sử dụng code:

PHP:

Sub test()
Debug.Print "'"
Debug.Print "'"
Debug.Print "'C:\$"
End Sub

code dùng để xoá comments:

PHP:

Option 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 Sub

nguồn:

Mã:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=266

Lưu ý: để chạy code trên phải đánh dấu tick vào Trust Access to the VBA project Object Model trong Trust Center Settings

View attachment 130517

Làm sao xóa tất cả các Comment trong VBA (1 người xem)

Người dùng đang xem chủ đề này

congnguyen88

Thành viên bị đình chỉ hoạt động

gtri

Thành viên tích cực

congnguyen88

Thành viên bị đình chỉ hoạt động

gtri

Thành viên tích cực

Hau151978

Thành viên tích cực

congnguyen88

Thành viên bị đình chỉ hoạt động

File đính kèm

gtri

Thành viên tích cực

kuldokk

Thành viên hoạt động

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.