Thử nghiệm vbcode highlight=vb

Liên hệ QC
OverAC

OverAC

Đỗ Nguyên Bình
Thành viên BQT
Administrator
Tham gia
30/5/06
Bài viết
2,683
Được thích
15,001
[noparse][highlight=vb]...[/highlight][/noparse]

So sánh với [noparse]
PHP: 
...
[/noparse]
[highlight=vb]Option Explicit
Dim endR As Long, SoDong As Long, iSh As Long, eRow As Long
Dim Sh As Worksheet, WsName As String, iR As Long, rngData As Range
Sub GanTmpNhap()
With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Sheets("TongHop").Select
[A6:F65000].ClearContents
With Sheets("TMP")
endR = .[A65000].End(xlUp).Row
'Set rngData = .Range("C1:C" & endR)
'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'endR = .[A65000].End(xlUp).Row
Set rngData = .Range("A1:A" & endR)
With rngData
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"A5"), Unique:=True
End With
.Range("A1:C" & endR).Name = "rngData"
.Range("D2:D" & endR).Name = "rngSL"
.Range("A2:A" & endR).Name = "rngMaHH"
End With
Range("Extract").ClearContents: Names("Extract").Delete
endR = [A6].End(xlDown).Row
With Application
.Calculation = xlCalculationAutomatic
End With
With Range(Cells(6, 2), Cells(endR, 2))
.FormulaR1C1 = "=vlookup(RC1,rngData,2,0)"
.Offset(, 1).FormulaR1C1 = "=vlookup(RC1,rngData,3,0)"
End With
With Range(Cells(6, 2), Cells(endR, 3))
.Value = .Value
End With
Names("rngData").Delete
TaoSLNhap

With Application
.DisplayAlerts = True: .ScreenUpdating = True
End With


End Sub

Sub TaoSLNhap()
Range(Cells(6, 4), Cells(endR, 4)).FormulaR1C1 = "=SUMIF(rngMaHH,RC[-3],rngSL)"
Range(Cells(6, 2), Cells(endR, 4)).Value = Range(Cells(6, 2), Cells(endR, 4)).Value

Names("rngSL").Delete: Names("rngMaHH").Delete
Set rngData = Nothing
With Sheets("TMP")
.[A2:N65000].ClearContents
End With
End Sub
[/highlight]
PHP: 
Option Explicit
Dim endR As Long, SoDong As Long, iSh As Long, eRow As Long
Dim Sh As Worksheet, WsName As String, iR As Long, rngData As Range
Sub GanTmpNhap()
With Application
  .DisplayAlerts = False:  .ScreenUpdating = False:  .Calculation = xlCalculationManual
End With
Sheets("TongHop").Select
[A6:F65000].ClearContents
With Sheets("TMP")
    endR = .[A65000].End(xlUp).Row
    'Set rngData = .Range("C1:C" & endR)
    'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    'endR = .[A65000].End(xlUp).Row
       Set rngData = .Range("A1:A" & endR)
    With rngData
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "A5"), Unique:=True
    End With
    .Range("A1:C" & endR).Name = "rngData"
    .Range("D2:D" & endR).Name = "rngSL"
    .Range("A2:A" & endR).Name = "rngMaHH"
End With
Range("Extract").ClearContents: Names("Extract").Delete
endR = [A6].End(xlDown).Row
With Application
  .Calculation = xlCalculationAutomatic
End With
With Range(Cells(6, 2), Cells(endR, 2))
    .FormulaR1C1 = "=vlookup(RC1,rngData,2,0)"
    .Offset(, 1).FormulaR1C1 = "=vlookup(RC1,rngData,3,0)"
End With
With Range(Cells(6, 2), Cells(endR, 3))
    .Value = .Value
End With
Names("rngData").Delete
TaoSLNhap
 
With Application
  .DisplayAlerts = True: .ScreenUpdating = True
End With
 
 
End Sub
 
Sub TaoSLNhap()
Range(Cells(6, 4), Cells(endR, 4)).FormulaR1C1 = "=SUMIF(rngMaHH,RC[-3],rngSL)"
Range(Cells(6, 2), Cells(endR, 4)).Value = Range(Cells(6, 2), Cells(endR, 4)).Value
 
Names("rngSL").Delete: Names("rngMaHH").Delete
Set rngData = Nothing
With Sheets("TMP")
    .[A2:N65000].ClearContents
End With
End Sub

Mã: 
Option Explicit
Dim endR As Long, SoDong As Long, iSh As Long, eRow As Long
Dim Sh As Worksheet, WsName As String, iR As Long, rngData As Range
Sub GanTmpNhap()
With Application
  .DisplayAlerts = False:  .ScreenUpdating = False:  .Calculation = xlCalculationManual
End With
Sheets("TongHop").Select
[A6:F65000].ClearContents
With Sheets("TMP")
    endR = .[A65000].End(xlUp).Row
    'Set rngData = .Range("C1:C" & endR)
    'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    'endR = .[A65000].End(xlUp).Row
       Set rngData = .Range("A1:A" & endR)
    With rngData
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "A5"), Unique:=True
    End With
    .Range("A1:C" & endR).Name = "rngData"
    .Range("D2:D" & endR).Name = "rngSL"
    .Range("A2:A" & endR).Name = "rngMaHH"
End With
Range("Extract").ClearContents: Names("Extract").Delete
endR = [A6].End(xlDown).Row
With Application
  .Calculation = xlCalculationAutomatic
End With
With Range(Cells(6, 2), Cells(endR, 2))
    .FormulaR1C1 = "=vlookup(RC1,rngData,2,0)"
    .Offset(, 1).FormulaR1C1 = "=vlookup(RC1,rngData,3,0)"
End With
With Range(Cells(6, 2), Cells(endR, 3))
    .Value = .Value
End With
Names("rngData").Delete
TaoSLNhap
 
With Application
  .DisplayAlerts = True: .ScreenUpdating = True
End With
 
 
End Sub
 
Sub TaoSLNhap()
Range(Cells(6, 4), Cells(endR, 4)).FormulaR1C1 = "=SUMIF(rngMaHH,RC[-3],rngSL)"
Range(Cells(6, 2), Cells(endR, 4)).Value = Range(Cells(6, 2), Cells(endR, 4)).Value
 
Names("rngSL").Delete: Names("rngMaHH").Delete
Set rngData = Nothing
With Sheets("TMP")
    .[A2:N65000].ClearContents
End With
End Sub
 
Lần chỉnh sửa cuối:
Bình ơi, cái vb code đúng tốt đấy, nhưng màu chưa đúng, nên để các từ khóa của CB là màu xanh còn các giá trị khác để màu đẹn Tám lại chỉ nên để 3 màu:
+ Từ khóa
+ Giá trị
+ Comment
Mã: 
[COLOR="Blue"]Sub[/COLOR] DoYourMacto()
[COLOR="Green"]    'If Your Macto is running then exit sub[/COLOR]
   [COLOR="Blue"] If[/COLOR] IsRunning [COLOR="Blue"]Then[/COLOR]
[COLOR="Blue"]        Exit Sub
    End If
End Sub[/COLOR]
 
Điểm đáng chú ý:
1. highlight làm nổi bật những từ thuộc mặc định trong VB
2. Những dấu nháy đơn ' gần nhau sẽ được hiểu đúng là bắt đầu của một ghi chú (comment) chứ không phải bắt đầu của một đoạn text
3. highlight không phải là một vbcode chính thống của VBB nên nó dể bị làm mất đi những dấu khoảng trắng đầu dòng. (lỗi này sẽ xem xét khắc phục)

code ban đầu
Mã: 
Option Explicit
 
    'Set rngData = .Range("C1:C" & endR)
    'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    'endR = .[A65000].End(xlUp).Row

highlight
[highlight=vb]Option Explicit

'Set rngData = .Range("C1:C" & endR)
'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'endR = .[A65000].End(xlUp).Row
[/highlight]

php
PHP: 
Option Explicit
 
    'Set rngData = .Range("C1:C" & endR)
    'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    'endR = .[A65000].End(xlUp).Row
 
Lần chỉnh sửa cuối:
thử cái đã
[highlight=vb]

Dim endR As Long, SoDong As Long, iSh As Long, eRow As Long
Dim Sh As Worksheet, WsName As String, iR As Long, rngData As Range
Sub GanTmpNhap()
With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Sheets("TongHop").Select
[A6:F65000].ClearContents
With Sheets("TMP")
endR = .[A65000].End(xlUp).Row
'Set rngData = .Range("C1:C" & endR)
'rngData.SpecialCells(xlCellTypeBlanks).EntireRow. Delete
'endR = .[A65000].End(xlUp).Row
Set rngData = .Range("A1:A" & endR)
With rngData
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"A5"), Unique:=True
End With
.Range("A1:C" & endR).Name = "rngData"
.Range("D2:D" & endR).Name = "rngSL"
.Range("A2:A" & endR).Name = "rngMaHH"
End With
Range("Extract").ClearContents: Names("Extract").Delete
endR = [A6].End(xlDown).Row
With Application
.Calculation = xlCalculationAutomatic
End With
With Range(Cells(6, 2), Cells(endR, 2))
.FormulaR1C1 = "=vlookup(RC1,rngData,2,0)"
.Offset(, 1).FormulaR1C1 = "=vlookup(RC1,rngData,3,0)"
End With
With Range(Cells(6, 2), Cells(endR, 3))
.Value = .Value
End With
Names("rngData").Delete
TaoSLNhap

With Application
.DisplayAlerts = True: .ScreenUpdating = True
End With


End Sub

Sub TaoSLNhap()
Range(Cells(6, 4), Cells(endR, 4)).FormulaR1C1 = "=SUMIF(rngMaHH,RC[-3],rngSL)"
Range(Cells(6, 2), Cells(endR, 4)).Value = Range(Cells(6, 2), Cells(endR, 4)).Value

Names("rngSL").Delete: Names("rngMaHH").Delete
Set rngData = Nothing
With Sheets("TMP")
.[A2:N65000].ClearContents
End With
End Sub[/color]

[/highlight]

code này đúng là làm nổi bật vị trí :
Từ khóa
Giá trị
Comment
 
Lần chỉnh sửa cuối:
Đã đổi lại màu highlight

TuanVNUNI đã viết:
Bình ơi, cái vb code đúng tốt đấy, nhưng màu chưa đúng, nên để các từ khóa của CB là màu xanh còn các giá trị khác để màu đẹn Tám lại chỉ nên để 3 màu:
+ Từ khóa
+ Giá trị
+ Comment
Mã: 
[COLOR=Blue]Sub[/COLOR] DoYourMacto()
[COLOR=Green]    'If Your Macto is running then exit sub[/COLOR]
   [COLOR=Blue] If[/COLOR] IsRunning [COLOR=Blue]Then[/COLOR]
[COLOR=Blue]        Exit Sub
    End If
End Sub[/COLOR]
Nhấp chuột vào đây để mở rộng...


[highlight=VB]
Option Explicit
Dim endR As Long, SoDong As Long, iSh As Long, eRow As Long
Dim Sh As Worksheet, WsName As String, iR As Long, rngData As Range
Sub GanTmpNhap()
With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Sheets("TongHop").Select
[A6:F65000].ClearContents
With Sheets("TMP")
endR = .[A65000].End(xlUp).Row
'Set rngData = .Range("C1:C" & endR)
'rngData.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'endR = .[A65000].End(xlUp).Row
Set rngData = .Range("A1:A" & endR)
With rngData
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"A5"), Unique:=True
End With
.Range("A1:C" & endR).Name = "rngData"
.Range("D2:D" & endR).Name = "rngSL"
.Range("A2:A" & endR).Name = "rngMaHH"
End With
Range("Extract").ClearContents: Names("Extract").Delete
endR = [A6].End(xlDown).Row
With Application
.Calculation = xlCalculationAutomatic
End With
With Range(Cells(6, 2), Cells(endR, 2))
.FormulaR1C1 = "=vlookup(RC1,rngData,2,0)"
.Offset(, 1).FormulaR1C1 = "=vlookup(RC1,rngData,3,0)"
End With
With Range(Cells(6, 2), Cells(endR, 3))
.Value = .Value
End With
Names("rngData").Delete
TaoSLNhap

With Application
.DisplayAlerts = True: .ScreenUpdating = True
End With


End Sub

Sub TaoSLNhap()
Range(Cells(6, 4), Cells(endR, 4)).FormulaR1C1 = "=SUMIF(rngMaHH,RC[-3],rngSL)"
Range(Cells(6, 2), Cells(endR, 4)).Value = Range(Cells(6, 2), Cells(endR, 4)).Value

Names("rngSL").Delete: Names("rngMaHH").Delete
Set rngData = Nothing
With Sheets("TMP")
.[A2:N65000].ClearContents
End With
End Sub
[/highlight]
 
Không biết mình có thể đặt tên lại cho Tag VB code hay không? Nếu được chúng ta nên đặt tên là Tag GPE.

[GPE]

[/GPE]
Như vậy sẽ dễ nhớ và hay hơn.

Vbavn
 
Phong ơi, Name không phải là từ khoa.

Nếu có thể chúng ta để màu xanh đen dễ nhìn và giống với format chuẩn của VB hợn
 
@anh vbavn: Nếu sửa được thì em nghĩ là nên sửa thành VBA chứ GPE thì không đặc trưng.

@anh Tuanvnuni: Những từ như Name, End được ghi nhận như một từ khóa, do vậy hể gặp là tô đậm chứ code này không biệt được .Name khác Name và .End khác End, vậy thì sửa sẽ càng tốn nhiều thời gian hơn (chưa kể làm không được do những hạn chế khác)
 
Name hay .Name đều là đối tượng ứng dụng thôi chứ không phải là từ khóa trong VB/VBA, nên Name cần để màu đen Bình à. Anh không biết mã nguồn này trên Web như thế nào, như ở lập trình ứng dụng anh chỉ cần xóa nó khỏi danh sách các từ khóa là xong.
 
Đây là mà nguồn mở, của tác giả Roberto Rossi (rsoftware@altervista.org) (http://qbnz.com/highlighter)

Tác giả liệt kê Name như là từ khoá:

PHP: 
 $language_data = array (
    'LANG_NAME' => 'Visual Basic for Application',
    'COMMENT_SINGLE' => array(1 => "'"),
    'COMMENT_MULTI' => array(),
    'CASE_KEYWORDS' => GESHI_CAPS_NO_CHANGE,
    'QUOTEMARKS' => array('"'),
    'ESCAPE_CHAR' => '',
    'KEYWORDS' => array(
        1 => array(
            'as', 'err', 'boolean', 'and', 'or', 'recordset', 'unload', 'to',
            'integer','long','single','new','database','nothing','set','close',
            'open','print','split','line','field','querydef','instrrev',
            'abs','array','asc','ascb','ascw','atn','avg','me',
            'cbool','cbyte','ccur','cdate','cdbl','cdec','choose','chr','chrb','chrw','cint','clng',
            'command','cos','count','createobject','csng','cstr','curdir','cvar','cvdate','cverr',
            'date','dateadd','datediff','datepart','dateserial','datevalue','day','ddb','dir','doevents',
            'environ','eof','error','exp',
            'fileattr','filedatetime','filelen','fix','format','freefile','fv',
            'getallstrings','getattr','getautoserversettings','getobject','getsetting',
            'hex','hour','iif','imestatus','input','inputb','inputbox','instr','instb','int','ipmt',
            'isarray','isdate','isempty','iserror','ismissing','isnull','isnumeric','isobject',
            'lbound','lcase','left','leftb','len','lenb','loadpicture','loc','lof','log','ltrim',
            'max','mid','midb','min','minute','mirr','month','msgbox',
            'now','nper','npv','oct','partition','pmt','ppmt','pv','qbcolor',
            'rate','rgb','right','rightb','rnd','rtrim',
            'second','seek','sgn','shell','sin','sln','space','spc','sqr','stdev','stdevp','str',
            'strcomp','strconv','string','switch','sum','syd',
            'tab','tan','time','timer','timeserial','timevalue','trim','typename',
            'ubound','ucase','val','var','varp','vartype','weekday','year',
            'appactivate','base','beep','call','case','chdir','chdrive','const',
            'declare','defbool','defbyte','defcur','defdate','defdbl','defdec','defint',
            'deflng','defobj','defsng','defstr','deftype','defvar','deletesetting','dim','do',
            'else','elseif','end','enum','erase','event','exit','explicit',
            'false','filecopy','for','foreach','friend','function','get','gosub','goto',
            'if','implements','kill','let','lineinput','lock','loop','lset','mkdir','name','next','not',
            'onerror','on','option','private','property','public','put','raiseevent','randomize',
            'redim','rem','reset','resume','return','rmdir','rset',
            'savepicture','savesetting','sendkeys','setattr','static','sub',
            'then','true','type','unlock','wend','while','width','with','write',
            'vbabort','vbabortretryignore','vbapplicationmodal','vbarray',
            'vbbinarycompare','vbblack','vbblue','vbboolean','vbbyte','vbcancel',
            'vbcr','vbcritical','vbcrlf','vbcurrency','vbcyan','vbdataobject',
            'vbdate','vbdecimal','vbdefaultbutton1','vbdefaultbutton2',
            'vbdefaultbutton3','vbdefaultbutton4','vbdouble','vbempty',
            'vberror','vbexclamation','vbfirstfourdays','vbfirstfullweek',
            'vbfirstjan1','vbformfeed','vbfriday','vbgeneraldate','vbgreen',
            'vbignore','vbinformation','vbinteger','vblf','vblong','vblongdate',
            'vblongtime','vbmagenta','vbmonday','vbnewline','vbno','vbnull',
            'vbnullchar','vbnullstring','vbobject','vbobjecterror','vbok','vbokcancel',
            'vbokonly','vbquestion','vbred','vbretry','vbretrycancel','vbsaturday',
            'vbshortdate','vbshorttime','vbsingle','vbstring','vbsunday',
            'vbsystemmodal','vbtab','vbtextcompare','vbthursday','vbtuesday',
            'vbusesystem','vbusesystemdayofweek','vbvariant','vbverticaltab',
            'vbwednesday','vbwhite','vbyellow','vbyes','vbyesno','vbyesnocancel',
            'vbnormal','vbdirectory'
            )
        ),
    'SYMBOLS' => array(
        '(', ')'
        ),
    'CASE_SENSITIVE' => array(
        GESHI_COMMENTS => false,
        1 => false
        ),
    'STYLES' => array(
        'KEYWORDS' => array(
            1 => 'color: #b1b100;'
            ),
        'COMMENTS' => array(
            1 => 'color: #808080;'
            ),
        'BRACKETS' => array(
            0 => 'color: #66cc66;'
            ),
        'STRINGS' => array(
            0 => 'color: #ff0000;'
            ),
        'NUMBERS' => array(
            0 => 'color: #cc66cc;'
            ),
        'METHODS' => array(
            0 => 'color: #66cc66;'
            ),
        'SYMBOLS' => array(
            0 => 'color: #66cc66;'
            ),
        'ESCAPE_CHAR' => array(
            0 => 'color: #000099;'
            ),
        'SCRIPT' => array(
            ),
        'REGEXPS' => array(
            )
        ),
    'OOLANG' => true,
    'OBJECT_SPLITTERS' => array(
        1 => '.'
        ),
    'REGEXPS' => array(
        ),
    'STRICT_MODE_APPLIES' => GESHI_NEVER,
    'SCRIPT_DELIMITERS' => array(
        ),
    'HIGHLIGHT_STRICT_BLOCK' => array(
        )
);
Tác giả không có tách riêng phần highlight cho VBA nên mình dùng VB để thay. Nếu sau khi bỏ bớt các từ khoá thì mình có thể rename thành VBA cũng được.

Về màu sắc thì tuỳ chỉnh rất đa dạng (xem code trên) thích màu nào thì chỉ cần nhập mã màu (HEX) vào.

Thanh Phong
 
Lần chỉnh sửa cuối:
[highlight=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim strVal As String
Dim strEntry As String
On Error Resume Next
strVal = Target.Validation.Formula1
If Not strVal = vbNullString Then
strEntry = Target
Application.EnableEvents = False
With Sheet1.Range("MyList")
.Replace What:=strEntry, _
Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False
.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
.Range("A1", .Range("A65536").End(xlUp)).Name = "MyList"
End With
End If
Application.EnableEvents = True
On Error GoTo 0
End Sub[/highlight]
 
A Tool pro có virus

Chào TuanVNUNI
Máy của tôi cài trình diệt virus ESS NOD32. khi toi chạy chương trinh A Tool . . . thì bị báo có Virus và nó diệt luôn. Mong TuanVNUNI kiểm tra lại chương trình A Tool có bị nhiễm virus không nhé.
 
Phong ơi,

Vậy mình có thể tích hợp vào diễn đàn cái vụ này được không?

Tks,

Lê Văn Duyệt
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
Trả lời
10
Đọc
91
kentshjnks
K
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
12
Đọc
318
S.Ha
S
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
8
Đọc
193
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
21
Đọc
368
Emyeuexcel
Emyeuexcel
hongquan93vn
Giữ được Hide dòng khi dùng "clear" trong phần học
Trả lời
3
Đọc
62
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom