ndthanh

Sub Format_func()
 
Worksheets(2).Activate
 
'Number

Cells(2, 3) = 123456
 
Cells(3, 3) = Format(Cells(2, 3), "General Number")
 

ndthanh

Sub HoaHoc()
    For Each cll In Selection
        sText = cll.Value
        For i = 1 To Len(sText)
            If IsNumeric(Mid(sText, i, 1)) Then cll.Characters(Start:=i, Length:=1).Font.Subscript = True
        Next
    Next
End Sub

ndthanh

Sub MergeSameCell()
'https://www.hocexcel.online
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "Hoc Excel Online"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count

ndthanh

'https://www.hocexcel.online
Function hTextJoin(d As String, e As Boolean, r As Range) As String
    If r.Count = 1 Then hTextJoin = r.Value
    Dim a, b As Long, c As String
    If r.Rows.Count = 1 Then
        a = Application.Transpose(Application.Transpose(r))
    ElseIf r.Columns.Count = 1 Then
        a = Application.Transpose(r)
    Else
        hTextJoin = "!!!not support"

ndthanh

'https://blog.hocexcel.online/huong-dan-cach-gop-nhieu-dong-thanh-mot-dong-trong-mot-o-tinh-excel.html
'https://hocexcel.online
Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each MyRange In ActiveSheet.UsedRange
        If 0 < InStr(MyRange, Chr(10)) Then
            MyRange = Replace(MyRange, Chr(10), "")
        End If

ndthanh

Public Function strSimLookup(str1 As Variant, rRng As Range, Optional returnType) As Variant
'Return either the best match or the index of the best match
'depending on returnTYype parameter) between str1 and strings in rRng)
' returnType = 0 or omitted: returns the best matching string
' returnType = 1           : returns the index of the best matching string
' returnType = 2           : returns the similarity metric

    Dim sPairs1 As Collection
    Dim sPairs2 As Collection
    Dim metric, bestMetric As Double

ndthanh

Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
'sArray: mảng 2 chiều trên sheet
'colIndex: cột cần lọc
'FindStr: dữ liệu cần lọc
'HasTitle: Mảng nguồn có tiêu đề hay không
    Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
    On Error Resume Next
    Set Dic = CreateObject("Scripting.Dictionary")
        TmpArr = sArray
        ColIndex = ColIndex + LBound(TmpArr, 2) - 1

ndthanh

Function ExtractEmailAddress(s As String) As String
    Dim AtSignLocation As Long
    Dim i As Long
    Dim TempStr As String
    Const CharList As String = "[A-Za-z0-9._-]"
    
    'Get location of the @
    AtSignLocation = InStr(s, "@")
    If AtSignLocation = 0 Then
        ExtractEmailAddress = "" 'not found

ndthanh

Public Function lay_so(s As String) As String
    Dim s2 As String
    Dim replace_hyphen As String
    replace_hyphen = " "
    Set re = CreateObject("vbscript.regexp")
    If re Is Nothing Then Set re = CreateObject("vbscript.regexp")
    re.IgnoreCase = True
    re.Global = True
    re.Pattern = "[^0-9 -]" 'includes space, if you want to exclude space "[^0-9]"
    s2 = re.Replace(s, vbNullString)

ndthanh

Sub RemoveLeadingSpace()
  'Updateby20131129
  Dim Rng As Range
  Dim WorkRng As Range
  On Error Resume Next
  xTitleId = "Hoc Excel Online"
  Set WorkRng = Application.Selection
  Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
  For Each Rng In WorkRng
      Rng.Value = VBA.LTrim(Rng.Value)