Cách xoá toàn bộ làm tròn (Round, Roundup, Rounddown...)

[Decepticon]

Như tít , các bác có cách nào xoá toàn bộ làm tròn kể cả round nằm giữa công thức không ạ, hàm round ngay sau dấu = thì dễ chứ nằm giữa công thức thì khó xử lý quá ><

 

[bebo021999]

vba nhé bạn, gửi file lên đi

 

[Decepticon]

vba nhé bạn, gửi file lên đi

em đưa 1 ví dụ nha bác:

- Công thức gốc: =rounddown(subtotal(9,A1:A2),-1)+round(A3/A4,-3)+roundup(A5/A6,)
- Công thức sửa đổi =subtotal(9,A1:A2)+A3/A4+A5/A6

 

[Mr.hieudoanxd]

em đưa 1 ví dụ nha bác:

- Công thức gốc: =rounddown(subtotal(9,A1:A2),-1)+round(A3/A4,-3)+roundup(A5/A6,)
- Công thức sửa đổi =subtotal(9,A1:A2)+A3/A4+A5/A6

Đang học Regex trình độ gà nên e tách được trường hợp Round và RoundUp, chờ xem các thành viên khác trên diễn đàn xử lý thêm đồng xem bòn mót được thêm tí nào không. :V.
P/s: Đoán là do chủ thớt ghi thiếu số 0 ở cuối hàm roundup nên thêm 0 ở cuối hàm Roundup

Function RemoveRound(formula As String) As String
    Dim str As String
    Dim regRound As Object, regRoundDown As Object, regRoundUp As Object
    
    Set regRound = CreateObject("VBScript.RegExp")
    Set regRoundDown = CreateObject("VBScript.RegExp")
    Set regRoundUp = CreateObject("VBScript.RegExp")
    
    With regRound
        .Pattern = "\bROUND\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With

    With regRoundDown
        .Pattern = "\bROUNDDOWN\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With
    
    With regRoundUp
        .Pattern = "\bROUNDUP\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With
    

    str = regRound.Replace(formula, "$1")
    str = regRoundDown.Replace(str, "$1")
    str = regRoundUp.Replace(str, "$1")
    
    RemoveRound = str
End Function

Sub test()
    Dim str As String
    str = "=rounddown(subtotal(9,A1:A2),-1)+round(A3/A4,-3)+roundup(A5/A6,0)"
    Range("A3") = RemoveRound(str)
End Sub

 

[Decepticon]

Đang học Regex trình độ gà nên e tách được trường hợp Round và RoundUp, chờ xem các thành viên khác trên diễn đàn xử lý thêm đồng xem bòn mót được thêm tí nào không. :V.
P/s: Đoán là do chủ thớt ghi thiếu số 0 ở cuối hàm roundup nên thêm 0 ở cuối hàm Roundup

Function RemoveRound(formula As String) As String
    Dim str As String
    Dim regRound As Object, regRoundDown As Object, regRoundUp As Object
    
    Set regRound = CreateObject("VBScript.RegExp")
    Set regRoundDown = CreateObject("VBScript.RegExp")
    Set regRoundUp = CreateObject("VBScript.RegExp")
    
    With regRound
        .Pattern = "\bROUND\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With

    With regRoundDown
        .Pattern = "\bROUNDDOWN\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With
    
    With regRoundUp
        .Pattern = "\bROUNDUP\(([^,]+),[^)]+\)"
        .Global = True
        .IgnoreCase = True
    End With
    

    str = regRound.Replace(formula, "$1")
    str = regRoundDown.Replace(str, "$1")
    str = regRoundUp.Replace(str, "$1")
    
    RemoveRound = str
End Function

Sub test()
    Dim str As String
    str = "=rounddown(subtotal(9,A1:A2),-1)+round(A3/A4,-3)+roundup(A5/A6,0)"
    Range("A3") = RemoveRound(str)
End Sub

test thử hàm này không được bác ơi =LEFT(1+ROUND(1+MID(1+ROUNDUP(A1;0)+1;2;2)+RIGHT(1+ROUNDDOWN(A1;0)+1;2););2)

 

[Mr.hieudoanxd]

test thử hàm này không được bác ơi =LEFT(1+ROUND(1+MID(1+ROUNDUP(A1;0)+1;2;2)+RIGHT(1+ROUNDDOWN(A1;0)+1;2););2)

Không cần test chắc chắn không được nhé bác nhé

 

[VetMini]

Bài này theo kiến thức tôi thì không dễ ăn.
Người làm phải có chút kiến thức về "token" của trình dịch.
Round/up/down là bắt đầu một token, bên trong nó có thể chứa không hoặc nhiều tokens khác.
Vì vậy, ngay sau các từ khóa này là trình dịch bắt đầu đếm các "(" và ")". Khi số "(" bằng số ")" thì là chỗ kết của token.
Dùng phương pháp ấy, xong đếm ngược lại 1 ")" và xóa các tham số trừ tham đầu tiên (tức là con toán). Xong, xóa từ khóa (Round...). Lưu ý là phải chừa lại cặp "()" vì con toán có thể thuộc dạng phức tạp, bỏ "()" ra là tính tùm lum hết.
Việc compiler lấy tokens còn vấn đề phức tạp nữa là khi gặp dấu ". "(" và ")" có thể nằm trong chuỗi constant, phải biết cách lướt qua chúng. Nhưng có lẽ trường hợp ở đây là côn toán cho nên sẽ không gặp.

 

[Mr.hieudoanxd]

Vì vậy, ngay sau các từ khóa này là trình dịch bắt đầu đếm các "(" và ")". Khi số "(" bằng số ")" thì là chỗ kết của token.

Thú thật trước bài này của chủ bài đăng em cũng đã muốn loại hàm round hoặc thêm hàm round vào mà chưa nghĩ ra phương án nào hợp lý. Phần này của bác em cũng đã nghĩ qua nhưng chưa tìm được giải thuật cho hợp lý kể cả đếm số lượng "(" và ")"

 

[huuthang_bd]

Nếu làm cho hoàn chỉnh thì ngoài các vấn đề đề cập ở bài #7 còn phải xử lý tên file và tên sheet trong tham chiếu nữa. Không phải không làm được nhưng không đáng cho một yêu cầu như topic này.
--
Tôi nghĩ chủ topic chỉ thực hiện công việc này 1 lần nên tìm và sửa thủ công là cách làm hiệu quả và an toàn nhất.

 

[Decepticon]

Nếu làm cho hoàn chỉnh thì ngoài các vấn đề đề cập ở bài #7 còn phải xử lý tên file và tên sheet trong tham chiếu nữa. Không phải không làm được nhưng không đáng cho một yêu cầu như topic này.
--
Tôi nghĩ chủ topic chỉ thực hiện công việc này 1 lần nên tìm và sửa thủ công là cách làm hiệu quả và an toàn nhất.

Không đáng là ntn bạn :-? Rất nhiều người cần huỷ làm tròn, chẳng qua không ai biết cách nên mới phải sửa thủ công thoai, độ cần chắc chỉ sau hàm Bằng chữ :sure:

 

[cantl]

Thêm và bỏ hàm round thì tớ cũng hay gặp, nhưng:
1 là chỉ duy nhất 1 round ngoài cùng.
2 là chỉ là round chứ không đown up.
Bài này cứ đếm round và ngoặc lần lượt, nhưng cũng mất công thiệt.

Hề hề, đó là ý tưởng.

 

[huuthang_bd]

Không đáng là ntn bạn :-? Rất nhiều người cần huỷ làm tròn, chẳng qua không ai biết cách nên mới phải sửa thủ công thoai, độ cần chắc chỉ sau hàm Bằng chữ :sure:

Đáng hay không thì người bỏ công ra làm mới biết, bạn chỉ đưa ra yêu cầu nhưng không biết được để thực hiện yêu cầu đó cần phải làm những gì thì không thể nào biết được có đáng hay không.
Rất nhiều người muốn bỏ làm tròn là do bạn nói chứ chẳng có cơ sở nào cả, nếu có thì một vài công thức người ta sửa thủ công trong 30 giây là xong.
Trường hợp muốn bỏ làm tròn cho toàn bộ file với rất nhiều công thức là đặc thù và rất hiếm khi xảy ra.

 

[HeSanbi]

Tôi có viết phương thức FxParseConvert trong Add-in FormulaBeautiXL, phương thức này có chức năng phân tích toàn bộ biểu thức Excel thành từng phần cấu trúc.

Dựa vào phương thức này có thể thêm nhiều chức năng để thực hiện với biểu thức như:

1. Xóa
2. Chèn
3. Loại bỏ
4. Dịch chuyển
5. Hoán vị
6. Thay thế
7. Tìm ô tham chiếu đến và tham chiếu đi
8. Biểu diễn mô hình cây
9. Chuyển đối dấu phân tách đối số và phân tách mảng.

Dự án mã cho các bạn tham khảo:

Option Explicit
Option Compare Text
Option Private Module
Private Enum FormulaExpressionsType
  fptElement = 0
  fptFunction
  fptArgument
  fptGroup
End Enum

Private Enum ParameterTextType
  pttFxStart = 1
  pttSheetObject
  pttSheetObjectSpecial
  pttCell
  pttNumber
  pttNumberInArray
  pttString
  pttStringInArray
  pttArgumentBreak
  pttArray
  pttTable
  pttTableAt
  pttTableGroup
  pttTableGroup1
  pttTableGroup2
  pttTableGroup20
  pttKeywork
  pttKeyworkStart2
  pttBlockStart
  pttBlankMark
End Enum


Private Enum FxParseSyntaxError
  DPSENotSupportSeparator = 800
  DPSEBlockClosedNotValid
  DPSEBlockClosedOutside
  DPSEKeywordNotValid
  DPSETwoLockRange
  DPSESyntaxError
  DPSENumberLongNotValid
  DPSESeparatorArray
  DPSESyntaxOfCell
  DPSEZeroBeforeColonCell
  DPSESheetRoot
  DPSESpillOperator
  DPSEZeroFront
  DPSE9
End Enum

Public Enum MainSyntaxExpressions
  MSE
  MSEBracketOpen '  ' (
  MSEBracketClose ' ' )
  MSESeparator '    ' ; ,
  MSESeparatorArray ' ; , /
  MSEOperator '     ' + - * / = > < >= <= <> &
  MSESign '         ' --
  MSEFunc '         ' Now()  ...

  MSEBoolean '      ' TRUE FALSE
  MSENumber '       ' -12.23
  MSEString '       ' "abc"   """a"""
  MSEErrVar '       ' #REF!  #NULL!  #DIV/0!  #VALUE!  #NAME?  #NUM!  #N/A  #SPILL!  #CALC!
  '
  MSERange '        ' A1:A2
  MSENamed '        ' abcdef09
  MSETable '        ' [#All]  [#Headers]  [#Totals]  [#Data]  [#This Row]
  '                 ' [@[column 1]]  table1[column 1]
  MSEArray '        ' {1,2,3;4,5,6;"a","b","c";TRUE,TRUE,TRUE}
                    ' {1\2\3;4\5\6;"a"\"b"\"c";TRUE\TRUE\TRUE}
  MSEiio '          ' @ implicit intersection operator
  MSEArrayReference ' # Array Reference of a Cell Address
End Enum


Private Enum SyntaxKeyExpressions
  skeFxStart = 1
  skeFx
  skeFxNotArguments
  skeNamed
  skeSheet
  '------------------------
  skeRootBlockOpen
  skeRootOpen
  skeRootName
  skeRootClose
  skeRootSheet
  skeRootBlockClose
  skeRoot
  '------------------------
  skeCell
  skeCellBreak
  skeCellLock
  skeCellAddress
  skeCellDigitAddress
  skeCellColon
  skeCellErrREF
  skeSpillOperator
  skeFxIf
  skeFxIfs
  skeFxIfna
  skeFxIferror
  skeFxINDIRECT
  skeConstantsString
  skeConstantsBoolean
  skeNumber
  skeNumberLong
  skeNumberDecimal
  skeArgumentSeparator
  skeArrayRowSeparator
  skeArrayColumnSeparator
  skeArray
  skeKeywork
  skeKeyworkUnderscore
  skeExpressionsError
  skeSignNumber
  skeOperatorCompare
  skeOperatorArithmetic
  skeOperatorPercent
  skeOperatorText
  skeExpressions
  skeCommunicationMark
  skeAppClassMark
  skeBlock
  skeBlockStart
  skeBlockClose
  skeLockProject
  skeImplicitIntersectionOperator
End Enum

Private Enum SyntaxGroupExpressions
  sgeFx
  sgeFxNotArguments
  sgeNamed
  sgeObject
  sgeSheet
  sgeRoot
  sgeSpillOperator
  sgeFxINDIRECT
  sgeConstantsString
  sgeConstantsBoolean
  sgeNumber
  sgeArgumentSeparator
  sgeArrayRowSeparator
  sgeArrayColumnSeparator
  sgeArray
  sgeExpressionsError
  sgeSignNumber
  sgeOperatorCompare
  sgeOperatorArithmetic
  sgeOperatorPercent
  sgeOperatorText
  sgeExpressions
  sgeCommunicationMark
  sgeAppClassMark
  sgeBlockStart
  sgeLockProject
  sgeImplicitIntersectionOperator
End Enum

Private Const n_ = vbNullString

Private Sub FxParseConvert_test()
  Dim s
'   0  1   2   3   4
l___1_______________:    s = "=""Hello"""
l___2_______________:    s = s & "&"
                         s = s & "-@$A$1 + -PI() + "
                         s = s & "'[FindCellReferences.xlsm]Sheet1'!B2:X '[FindCellReferences.xlsm]Sheet1'!C2:F + "
l___3_______________:    s = s & "S_List("
                         s = s & "     -$A$6:$M$1200,"
l___3__1____________:    s = s & "     Sheet1!A4:M11:O12:Q13,"
l___3__2____________:    s = s & "     INDIRECT(""A9""),"
l___3__3____________:    s = s & "     SUM(A4,A7),"
l___3__4____________:    s = s & "     2%,"
l___3__5____________:    s = s & "     S_Cells("
l___3__5___0________:    s = s & "          [@[Header1]],"
l___3__5___1________:    s = s & "          Table2[Header1],"
l___3__5___2________:    s = s & "          Table2[ [#Data],[Header1] ],"
l___3__5___3________:    s = s & "          Table2[ [#Headers],[#Data],[Header 2] ],"
l___3__5___4________:    s = s & "          Table2[[ Header3 ]],"
l___3__5___5________:    s = s & "          Table2[[Header1]:[Header 2]],"
l___3__5___6________:    s = s & "          H3:L18,"
l___3__5___7________:    s = s & "          Sheet1!B2:F17,"
l___3__5___8________:    s = s & "          'Sheet1'!B2:F,"
l___3__5___9________:    s = s & "          '[FindCellReferences.xlsm]Sheet1'!B2:X,"
l___3__5___10_______:    s = s & "          Table1[column1] Table2[column1],"
l___3__5___11_______:    s = s & "          [@[Header1]] [@[Header2]]"
l___3__5e___________:    s = s & "    ),"
l___3__6____________:    s = s & "    ""Data Testing"","
l___3__7____________:    s = s & "    1,"
l___3__8___1________:    s = s & "    ("
l___3__8___1___1____:    s = s & "       (1/2+20)*(25-7)"
l___3__8___1e_______:    s = s & "    )/10,"
l___3__9____________:    s = s & "    {2;3;4},"
l___3_10____________:    s = s & "    TRUE"
l___3e______________:    s = s & ")"
l___4_______________:    s = s & "+"
l___5_______________:    s = s & "1000"
l___6_______________:    s = s & "+"
l___7_______________:    s = s & "("
l___7__1____________:    s = s & "    (SUM(A1:B9)/2)"
l___7e______________:    s = s & ")"
Debug.Print s
  Dim Fx1$, Fx2$, e1&, e2$
  Call FxParseConvert(formula:=s, SpacesIndent:=3, conversion:=0, FxMinified:=Fx1, FxFormated:=Fx2, errNumber:=e1, errDescription:=e2)
  Debug.Print e2
  If e1 = 0 Then
    Debug.Print Fx1
    Debug.Print Fx2
  End If
End Sub

Private Function FxParseConvert(ByVal formula, Optional ByVal RemoveFXs As Collection, Optional FxMinified$, Optional FxFormated$, Optional SpacesIndent = 3, _
        Optional conversion%, Optional errNumber As Long, _
        Optional errDescription$, Optional defaultSeparatorSettings As Boolean) As String
 
  errNumber = 0: errDescription = n_
  Const id = 2
  On Error Resume Next
  Dim tp As Boolean, av As Long, io1$, io2$, pt1$, pt2$, pt3$, pt4$, pt5$
  pt1 = "A-Za-z" & ChrW$(&H80) & "-" & ChrW$(&HFFFF&)
  pt2 = "[_0-9" & pt1 & "]"
  pt3 = "[_.0-9" & pt1 & "]"
  pt4 = "[$_0-9" & pt1 & "]"
  pt1 = "[" & pt1 & "]"
  pt5 = "_xnlf." & pt1
 
  tp = TypeName(formula) = "Range"
  Call OfficeVersion(newVersion:=av, implicitIntersectionOperator:=io1, SpillOperator:=io2)
 
  Dim r%, c%, rc%, cc%, uCells As Range, Cell As Range, z$, z2$, t, t1$, T2$, t3$, l, i%, i2%, si%, m1$, m2$, m12$, m3$, a, ae, ae2, o%
  Dim y As Boolean, uc As Boolean
  Dim Floor%, nfloor%, index%, ds$, sv$, sb$, ab$, ds0$, sb0$, ab0$, ds1$, sb1$, ab1$, ds2$, sb2$, ab2$, rr$, ss$, nr0$, nr1$, nr2$
  Dim ee As FxParseSyntaxError, ras As Boolean, ccas%, d1 As MainSyntaxExpressions, fxSyntaxs As Collection, fxSyntax As clsFxSyntax
  Dim floors%(0 To 200), blocks$(0 To 1, 0 To 200), iaFX%(0 To 200)
  Dim gt As SyntaxKeyExpressions, gt2 As SyntaxKeyExpressions
  Dim FA As ParameterTextType, FA2 As ParameterTextType
  Dim aa, aa1, ia%, pfxs As Collection, pfx As clsFxParse, xfx As ClsFX, Blocked As Boolean
  ae = Array("#REF!", "#NULL!", "#DIV/0!", "#VALUE!", "#NAME?", "#NUM!", "#N/A", "#SPILL!", "#CALC!")
  ae2 = Array("[#All]", "[#Headers]", "[#Totals]", "[#Data]", "[#This Row]")
  If Application.UseSystemSeparators Then
    ds1 = Application.International(xlDecimalSeparator)
  Else
    ds1 = Application.DecimalSeparator
  End If
  Select Case ds1
  Case ".": sb1 = ",": ab1 = ",": sb2 = ";": ab2 = "\": ds2 = ","
  Case ",": sb1 = ";": ab1 = "\": sb2 = ",": ab2 = ",": ds2 = "."
  Case Else:
    ee = DPSENotSupportSeparator: GoTo ErrorSyntax
    'MsgBox TimeOutSeconds:=6, _
          title:="Canh.r bao.s!", _
          Prompt:="Chuyen.er ddoi.or cu.s phap.s cong.o thuc.ws:\n chi.r ho.ox tro.wj dau.as thap.aj phan.a (,) hoac.wj (.)\n" & _
                  "Ban.j can.af cai.f ddat.wj lai.j tai.j File\/Options\/Advanced\/...separators"
    Exit Function
  End Select
  If (tp Or defaultSeparatorSettings) Then ds = ds1:  GoSub separators
  nr0 = "="
  If tp Then
    rc = formula.rows.count
    cc = formula.columns.count
    For r = 1 To rc
      For c = 1 To cc
        Set Cell = formula(r, c).MergeArea
        If Not uCells Is Nothing Then
          uc = Intersect(uCells, Cell) Is Nothing
          Set uCells = union(uCells, Cell)
        Else
          Set uCells = Cell: uc = True
        End If
        If uc Then
          If Cell.HasFormula Then
            If av And conversion <> 4 Then t = Cell.Formula2 Else t = Cell.formula
            T2 = t
            si = 2: l = Len(t): GoSub ParseConvert
            If Cell.HasArray And Abs(conversion) = 4 Then
              t = "ARRAYFORMULA(" & t & ")"
              T2 = nr0 & "ARRAYFORMULA(" & T2 & ")"
            Else
              t = nr0 & t: T2 = nr0 & " " & T2
            End If
          ElseIf IsNumeric(Cell.Value) Then
              t = Replace(Cell.Value, ds, ds0)
              T2 = t
          Else
            t = n_: T2 = t
          End If
          z = z & t: z2 = z2 & T2
        End If
        If c < cc Then z = z & vbTab: z2 = z2 & vbTab
      Next
      If r < rc Then z = z & vbNewLine: z2 = z2 & vbNewLine
    Next
    FxMinified = z: FxFormated = z2
  Else
    t = formula: l = Len(t): T2 = t
    If t Like "=*" Then si = 2 Else si = 1
    GoSub ParseConvert
    FxMinified = nr0 & t: FxFormated = nr0 & " " & T2
  End If
Exit Function
ParseConvert:
  Set pfxs = New Collection: Set xfx = Nothing: Set pfx = Nothing
  Set fxSyntaxs = New Collection
nw:
  FA = 0: rr = n_: ss = n_: t1 = n_: Floor = 0: gt = 0: gt2 = 0
  For i = si To l
a:
    m1 = Mid$(t, i, 1): nr1 = n_: nr2 = n_: d1 = 0
d:
    Select Case FA
    Case 0
      t1 = n_
      Select Case m1
      Case "$": t1 = m1: m1 = sv & m1: sv = n_: FA = pttCell: gt2 = skeCellLock
      Case """": t1 = m1: m1 = sv & m1: sv = n_: FA = pttString
      Case "[":
        GoSub NextChar1:
        If m2 = "@" Then Debug.Print "@: "; FA; pttTable; pttTableGroup: FA = pttTable: t1 = m12: m1 = sv & m12: i = i + 1 Else t1 = m1: m1 = sv & m1: FA = pttSheetObject: gt2 = skeRootName
        sv = n_:
      Case "'": t1 = m1: m1 = sv & m1: sv = n_: FA = pttSheetObjectSpecial: gt2 = skeRootBlockOpen
      Case "{": t1 = m1: m1 = sv & m1: sv = n_: FA = pttArray
      Case io1: sv = sv & m1: m1 = n_: gt2 = skeImplicitIntersectionOperator
      Case "_": t3 = Mid$(t, i, 7)
        If t3 Like pt5 Then
          t1 = t3: m1 = sv & m1: FA = pttKeywork: gt2 = skeKeyworkUnderscore: i = i + 6
        Else
          ee = DPSESyntaxError: GoTo ErrorSyntax
        End If
      Case "#":
        For Each a In ae
          If a = Mid$(t, i, Len(a)) Then m1 = a: i = i + Len(a) - 1: gt2 = skeExpressionsError: d1 = MSEErrVar: GoTo n
        Next
        ee = DPSESyntaxError: GoTo ErrorSyntax
      Case "(": GoSub skipUselessCharacters: If o = 1 Then ee = DPSEBlockClosedNotValid: GoTo ErrorSyntax
        m1 = sv & m1: sv = n_: d1 = MSEBracketOpen:
        GoSub oneArgument
        Floor = Floor + 1
        If o = 0 Then
          nr1 = vbLf & Space(Floor * SpacesIndent + id)
          floors(Floor) = 0
        Else
          floors(Floor) = 1
        End If
        blocks(0, Floor) = ")": FA = 0: t1 = n_
        gt2 = skeBlockStart
      Case ")": d1 = MSEBracketClose
        If Floor - 1 < 0 Then
          ee = DPSEBlockClosedOutside: GoTo ErrorSyntax
        End If
        If floors(Floor) = 1 Then
          nr1 = nr1 & vbLf & Space((Floor - 1) * SpacesIndent + id)
        Else
          If floors(Floor + 1) = 1 Then nr1 = nr1 & vbLf & Space((Floor - 1) * SpacesIndent + id): floors(Floor + 1) = 0
        End If
        blocks(1, Floor) = n_
        floors(Floor) = 0: Floor = Floor - 1: o = 0
      Case blocks(1, Floor): m1 = sb0: nr1 = n_: nr2 = vbLf & Space(Floor * SpacesIndent + id): gt2 = skeArgumentSeparator: d1 = MSESeparator
      Case " ", vbLf:  GoTo n2
      Case "%": gt2 = skeOperatorPercent
      Case "&": nr1 = " ": nr2 = " ": gt2 = skeOperatorText: d1 = MSEOperator
      Case "*", "^", "/": gt2 = skeOperatorArithmetic: nr1 = " ": nr2 = " ": d1 = MSEOperator
      Case "+", "-":
        Select Case gt2
        Case skeSignNumber, skeArgumentSeparator, skeBlockStart, skeOperatorText: sv = sv & m1: m1 = n_: gt2 = skeSignNumber: d1 = MSESign
        Case skeOperatorArithmetic: sv = sv & m1: m1 = n_:   gt2 = skeOperatorArithmetic: d1 = MSEOperator
        Case Else: nr1 = " ": nr2 = " ": sv = n_: gt2 = skeOperatorArithmetic: d1 = MSEOperator
        End Select
      Case Else:
        Select Case True
        Case sb = n_ And m1 Like "[,;]": ds = IIf(m1 = ";", ",", "."): d1 = MSESeparator: GoSub separators: GoTo nw
        Case m1 Like "#": m1 = sv & m1: t1 = m1: FA = pttNumber: gt2 = skeNumber: sv = n_
        Case m1 Like pt1: t1 = sv & m1: FA = pttKeywork:  m1 = n_: sv = n_
        Case Else
          GoSub NextChar1
          Select Case True
          Case m12 = "<=", m12 = ">=", m12 = "<>": m1 = m12: nr1 = " ": nr2 = " ": i = i + 1: gt2 = skeOperatorCompare
          Case m1 Like "[=<>]": nr1 = " ": nr2 = " ":  gt2 = skeOperatorCompare
          Case Else: ee = DPSEKeywordNotValid: GoTo ErrorSyntax
          End Select
        End Select
      End Select
    Case pttKeywork:
      Select Case True
      Case m1 Like ".": GoSub NextChar1: i = i + 1: If m2 Like pt1 Then m1 = m1 & m2 Else ee = DPSEKeywordNotValid: GoTo ErrorSyntax
        t1 = t1 & m1
      Case m1 Like pt2: t1 = t1 & m1
        If i = l Then d1 = MSENamed: GoSub add: GoSub addExpressions
      Case m1 Like "[*, )=<>+/^&#" & vbLf & "-]" Or i = l:
        Select Case t1
        Case "TRUE", "FALSE": gt2 = skeConstantsBoolean
        Case Else: gt2 = skeCell:
        End Select
        GoSub add: GoSub addExpressions: GoTo d
      Case m1 Like "[:!$]": t1 = t1 & m1: FA = pttCell: GoSub add:
        Select Case m1
        Case "$": gt2 = skeCellLock
        Case ":": gt2 = skeCellColon
        Case "!": gt2 = skeCellAddress
        End Select
      Case m1 = "[": t1 = t1 & m1: FA = pttTable: GoSub add:
      Case m1 = "(": d1 = MSEFunc
        Err.Clear: aa = RemoveFXs(t1): aa1 = aa(0): ia = aa(1)
        Err.Clear: Set pfx = pfxs(t1):
        If Err Then
          pfxs.add New clsFxParse, t1:
          Set pfx = pfxs(t1)
          With pfx
            .FirstIndex = i
            .FuncName = t1
          End With
        End If
        Set xfx = pfx.FxLast(True)
        t1 = t1 & m1
        GoSub skipUselessCharacters
        If o Then
           m1 = ")": t1 = t1 & m1: GoSub add: gt2 = skeFxNotArguments: GoSub addExpressions
        Else
          GoSub oneArgument
          If o = 0 And gt2 > 0 And gt2 <> skeArgumentSeparator Then nr1 = vbLf & Space(Floor * SpacesIndent + id)
          gt2 = skeFxStart: Floor = Floor + 1
          blocks(0, Floor) = m1
          blocks(1, Floor) = sb
          If o = 0 Then
            m1 = t1
            floors(Floor) = 1: nr2 = vbLf & Space(Floor * SpacesIndent + id)
            FA = 0: t1 = n_: GoTo n
          Else
            floors(Floor) = 0: GoSub add
          End If
          FA = 0: t1 = n_
        End If
      Case i = l
      Case Else: GoSub add: FA = 0: GoTo d
      End Select
      m1 = n_
    Case pttTable, pttTableGroup, pttTableGroup1, pttTableGroup2, pttTableGroup20:
      'https://support.microsoft.com/en-us/office/using-structured-references-with-excel-tables-f5ed2452-2337-4f71-bed3-c8ae6d2b276e
      Select Case FA
      Case pttTable, pttTableGroup1, pttTableGroup20:
        Select Case m1:
'        Case "#":
'          For Each a In ae2
'            If a = Mid$(T, i, Len(a)) Then m1 = a: i = i + Len(a) - 1: Exit For
'          Next
        Case "[": FA = pttTableGroup2
        Case "]": FA = 0
        Case " ":
          Select Case FA
          Case pttTable: FA = pttTableGroup: m1 = ""
          Case pttTableGroup20: m1 = ""
          End Select
        Case "'": i = i + 1: m1 = Mid$(t, i, 2)
        Case Else:
        End Select
      Case pttTableGroup:
        Select Case m1:
        Case "[": FA = pttTableGroup2
        Case "]": FA = 0: m1 = " ]"
        Case Else: FA = pttTableGroup1: m1 = " " & m1
        End Select
      Case pttTableGroup2:
        Select Case m1:
        Case "'": i = i + 1: m1 = Mid$(t, i, 2)
        Case "]": FA = pttTableGroup20: GoSub NextChar1: If m2 Like "[,;]" Then i = i + 1: m1 = m1 & sb0: If ds = n_ Then ds = IIf(m2 = ";", ",", "."): GoSub separators: GoTo nw
        End Select
      End Select
    Case pttNumber, pttNumberInArray:
      Select Case True
      Case m1 = ":": FA = pttCell
      Case ds = n_ And m1 = ".": t1 = t1 & m1: ds = m1:  GoSub separators: GoTo nw
      Case m1 Like "#": t1 = t1 & m1: gt2 = skeNumber
      Case m1 Like "[eE]": If gt2 = skeNumberLong Then ee = DPSENumberLongNotValid: GoTo ErrorSyntax:
        gt2 = skeNumberLong
        GoSub NextChar1: i = i + 1: If m2 Like "[+-]" Then m1 = m1 & m2 Else ee = DPSENumberLongNotValid: GoTo ErrorSyntax
        GoSub NextChar1: i = i + 1: If m2 Like "#" Then m1 = m1 & m2 Else ee = DPSENumberLongNotValid: GoTo ErrorSyntax
        t1 = t1 & m1
      Case m1 = ds: m1 = ds0: t1 = t1 & m1: If gt2 = skeNumberLong Then ee = DPSENumberLongNotValid: GoTo ErrorSyntax: GoTo d
      Case m1 Like "[*;, )=<>+/^&#%}" & vbLf & "\-]" Or i = l: FA = IIf(FA = pttNumberInArray, pttArray, 0): GoTo d
      Case Else: ee = DPSESyntaxError: GoTo ErrorSyntax
      End Select
    Case pttString, pttStringInArray:
      If m1 = """" Then
        GoSub NextChar1: If m2 = """" Then t1 = t1 & m1: m1 = m1 & m2: i = i + 1 Else gt2 = skeConstantsString: If FA = pttStringInArray Then FA = pttArray Else d1 = MSEString: GoSub addExpressions
      Else
        If i = l Then ee = DPSESyntaxError: GoTo ErrorSyntax
      End If
    Case pttSheetObject: t1 = t1 & m1
      Select Case True
      Case m1 = "!" And gt2 = skeRootSheet: FA = pttCell: gt2 = skeRoot: Return
      Case m1 = "]" And gt2 = skeRootName: gt2 = skeRootSheet
      Case m1 Like pt3 And gt2 = skeRootName:
      Case m1 Like pt2 And gt2 = skeRootSheet
      Case Else: GoTo ErrRootCell
      End Select
    Case pttSheetObjectSpecial: t1 = t1 & m1
      Select Case True
      Case m1 = "[": If gt2 <> skeRootBlockOpen Then GoTo ErrRootCell
        gt2 = skeRootOpen
      Case m1 = "]": If gt2 <> skeRootName Then GoTo ErrRootCell
        gt2 = skeRootClose
      Case m1 = "'": If i = l Then GoTo ErrRootCell
        If gt2 <> skeRootSheet Then GoTo ErrRootCell
        m2 = Mid$(t, i + 1, 1)
        If m2 <> "'" Then
          If m2 <> "!" Then GoTo ErrRootCell
          gt2 = skeRoot: FA = pttCell
        End If
        m1 = m1 & m2: t1 = t1 & m2: i = i + 1
      Case Else:
        'check characters
        Select Case gt2
        Case skeRootBlockOpen: If Not m1 Like "[_A-Za-z0-9]" Then GoTo ErrRootCell
          gt2 = skeRootSheet
        Case skeRootOpen, skeRootName: gt2 = skeRootName
        Case skeRootClose, skeRootSheet:  gt2 = skeRootSheet
        Case Else: GoTo ErrRootCell
        End Select
      End Select
    Case pttCell:
    ''       A1   A1:A5  1:1  A2:A   A:A   $A$1   $A$1:$A$5  $1:$1  $A$2:$A    $A:$A
      Select Case True
      Case m1 = "#": m1 = Mid$(t, i, 5): If Mid$(t, i, 5) <> ae(0) Then ee = DPSESyntaxError: GoTo ErrorSyntax
        i = i + 4: FA = 0: gt2 = skeCellErrREF
      Case m1 = "$":
        Select Case gt2
        Case 0, skeRoot, skeCellAddress, skeCellColon: gt2 = skeCellLock
        Case Else: ee = DPSETwoLockRange: GoTo ErrorSyntax
        End Select
      Case m1 Like "[A-Za-z]":
        Select Case gt2
        Case 0, skeRoot, skeCellLock, skeCellAddress, skeCellColon: gt2 = skeCellAddress
        Case Else: ee = DPSESyntaxOfCell: GoTo ErrorSyntax
        End Select
      Case m1 Like "[0-9]":
        Select Case gt2
        Case 0, skeRoot, skeCellColon:  gt2 = skeCellDigitAddress: If m1 = "0" Then ee = DPSEZeroFront: GoTo ErrorSyntax
        Case skeCellLock, skeCellAddress, skeCellDigitAddress:  gt2 = skeCellDigitAddress
        Case Else: ee = DPSESyntaxOfCell: GoTo ErrorSyntax
        End Select
      Case m1 = ":":
        Select Case gt2
        Case skeCellAddress, skeCellDigitAddress: gt2 = skeCellColon
        Case Else: ee = DPSESyntaxOfCell: GoTo ErrorSyntax
        End Select
      Case m1 = io2:
        Select Case gt2
        Case skeSpillOperator, skeCellAddress, skeCellDigitAddress: gt2 = skeSpillOperator
        Case Else: ee = DPSESpillOperator: GoTo ErrorSyntax
        End Select
      Case Else: o = 0
        #If DevCoding Then
        'If sb <> n_ Then Debug.Print "Cell:"; t1
        #End If
        If m1 = " " Then If gt2 = skeCellAddress Then GoSub twoReferences
        If o = 0 Then d1 = MSERange: GoSub addExpressions:   GoTo d
      End Select
      t1 = t1 & m1
    Case pttArray:
      t1 = t1 & m1:
      Select Case m1
      Case "-": t3 = Mid$(t, i + 1, 1): If t3 Like "#" Then m1 = m1 & t3: FA = pttNumberInArray: gt2 = skeNumber Else ee = skeConstantsBoolean: GoTo ErrorSyntax
      Case "0" To "9": FA = pttNumberInArray: gt2 = skeNumber
      Case """": FA = pttStringInArray: ras = False: ccas = 0
      Case "}": gt2 = skeArray: ras = False: ccas = 0: d1 = MSEArray: GoSub addExpressions
      Case "\", ab: If ab = n_ Then ds = ",": GoSub separators: GoTo nw
          m1 = ab0: nr2 = " "
      Case ";": ras = True: ccas = 0: m1 = m1 & " "
      Case ",":
        If ab <> Empty Then ee = DPSESeparatorArray: GoTo ErrorSyntax
        Select Case gt2
        Case skeConstantsString, skeConstantsBoolean: ds = ".": GoSub separators: GoTo nw
        Case Else: ccas = ccas + 1: If ccas >= 2 Then ds = ".": GoSub separators: GoTo nw
        End Select
        m1 = ab0:
      Case "T": t3 = Mid$(t, i, 4): If t3 = "TRUE" Then m1 = t3: gt2 = skeConstantsBoolean: ccas = 0: i = i + 3 Else ee = skeConstantsBoolean: GoTo ErrorSyntax
      Case "F": t3 = Mid$(t, i, 5): If t3 = "FALSE" Then m1 = t3: gt2 = skeConstantsBoolean: ccas = 0: i = i + 4 Else ee = skeConstantsBoolean: GoTo ErrorSyntax
      Case " ", vbLf: m1 = n_
      Case Else: ee = pttArray: GoTo ErrorSyntax
      End Select
    End Select
n:
    If Not Blocked Then
      ss = ss & m1
      rr = rr & nr1 & m1 & nr2
    End If
n2:
    If d1 > 0 Then
      fxSyntaxs.add New clsFxSyntax
      Set fxSyntax = fxSyntaxs(fxSyntaxs.count)
      With fxSyntax
        .defined = d1
        .FirstIndex = d1
        .EndIndex = i
        .Floor = Floor
        .indentLevel = Floor
        .syntax = t1
      End With
    End If
  Next
  If ds <> n_ Then t = ss & t1: T2 = rr & t1
Return
add: ss = ss & t1: rr = rr & t1: t1 = n_
Return
twoReferences:
  For i2 = i + 1 To l
    m3 = Mid$(t, i2, 1)
    Select Case True
    Case m3 = " ", m3 = vbLf:
    Case m3 = "'": m1 = m1 & m3: i = i2: o = 1: FA = pttSheetObjectSpecial: gt2 = skeRootBlockOpen: Return
    Case m3 = "[":
      m1 = m1 & m3: i = i2: o = 1: FA = pttSheetObject: gt2 = skeRootName:
      m2 = Mid$(t, i2 + 1, 1)
      If m2 = "@" Then m1 = m1 & m2: FA = pttTable: i = i2 + 1 Else FA = pttSheetObject: gt2 = skeRootName
      Return
    Case m3 Like "[$'_A-Za-z0-9]": m1 = m1 & m3: i = i2: o = 1: Return
    Case Else: i = i2 - 1: Return
    End Select
  Next
Return
NextChar1:
  If i < l Then m2 = Mid$(t, i + 1, 1): m12 = m1 & m2 Else m2 = n_: m12 = n_
Return
NextChar2:
  For i2 = i + 1 To l
    m3 = Mid$(t, i2, 1): Select Case m3: Case " ", vbLf: Case Else: m2 = m3: Return: End Select
  Next
  m2 = n_
Return

NextChar3:
  If i2 < l Then m2 = Mid$(t, i2 + 1, 1) Else m2 = n_
Return
Percentage: y = False
  For i2 = i + 1 To l
    Select Case Mid$(t, i2, 1)
    Case " ", vbLf:
    Case "%": y = True: i = i2: Exit For
    Case Else: Exit For
    End Select
  Next
Return
skipUselessCharacters: o = 0
  For i2 = i + 1 To l
    Select Case Mid$(t, i2, 1)
    Case " ", vbLf:
    Case ")": o = 1: i = i2: Exit For
    Case Else: i = i2 - 1: Exit For
    End Select
  Next
Return
oneArgument: FA2 = 0: o = 0: nfloor = Floor
  For i2 = i + 1 To l
    m3 = Mid$(t, i2, 1)
    Select Case FA2
    Case 0
      Select Case m3
      Case """": FA2 = pttString
      Case "'":  FA2 = pttSheetObjectSpecial:
      Case "{": FA2 = pttArray
      Case ")": o = 1: nfloor = nfloor - 1: If nfloor = (Floor - 1) Then Return
      Case sb, ";": Return
      Case "(": nfloor = nfloor + 1
      End Select
    Case pttString, pttStringInArray: If m3 = """" Then GoSub NextChar3: If m2 = """" Then i2 = i2 + 1 Else FA2 = IIf(FA2 = pttStringInArray, pttArray, 0)
    Case pttSheetObjectSpecial: If m3 = "'" Then GoSub NextChar3: If m2 = "'" Then i2 = i2 + 1 Else FA2 = 0
    Case pttArray:
      Select Case m3
      Case """": FA2 = pttStringInArray
      Case "}": FA2 = 0
      End Select
    Case pttTable, pttTableGroup1, pttTableGroup20:
      Select Case m3:
      Case "[": FA2 = pttTableGroup2
      Case "]": FA2 = 0
      Case " ": If FA2 = pttTable Then FA2 = pttTableGroup
      Case "'": i2 = i2 + 1
      End Select
    Case pttTableGroup: Select Case m3: Case "[": FA2 = pttTableGroup2: Case "]": FA2 = 0: Case Else: FA2 = pttTableGroup1: End Select
    Case pttTableGroup2: Select Case m3:: Case "'": i2 = i2 + 1:: Case "]": FA2 = pttTableGroup20:: End Select
    End Select
  Next
  ee = DPSESyntaxError: GoTo ErrorSyntax
Return



addExpressions:
  t1 = n_: FA = 0
Return
separators:
  Select Case ds
  Case ".": sb = ",": ab = ","
  Case ",": sb = ";": ab = "\"
  End Select
  Select Case True
  Case ds1 = "." And conversion = 4: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds1 = "." And conversion = -4: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case ds1 = "," And conversion = 4: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds1 = "," And conversion = -4: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case ds1 = "." And conversion = 3: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds1 = "." And conversion = -3: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case ds1 = "," And conversion = 3: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds1 = "," And conversion = -3: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case ds = "." And conversion = 2: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds = "." And conversion = -2: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case ds = "," And conversion = 2: ds0 = ds1: sb0 = sb1: ab0 = ab1
  Case ds = "," And conversion = -2: ds0 = ds2: sb0 = sb2: ab0 = ab2
  Case conversion = 1: ds0 = ".": sb0 = ",": ab0 = ","
  Case conversion = -1: ds0 = ",": sb0 = ";": ab0 = "\"
  Case Else: ds0 = ds: sb0 = sb: ab0 = ab
  End Select
Return
ErrRootCell:
  ee = DPSESheetRoot: GoTo ErrorSyntax
Exit Function
ErrorSyntax:
  errNumber = ee: rr = n_
  Select Case ee
  Case DPSENotSupportSeparator: rr = "Kh" & ChrW(244) & "ng h" & ChrW(7895) & " tr" & ChrW(7907) & " ph" & ChrW(226) & "n t" & ChrW(237) & "ch d" & ChrW(7845) & "u ph" & ChrW(226) & "n t" & ChrW(225) & "ch " & ChrW(273) & ChrW(7889) & "i s" & ChrW(7889) & " hi" & ChrW(7879) & "n t" & ChrW(7841) & "i!"
  Case DPSEBlockClosedNotValid: rr = "Nh" & ChrW(243) & "m bi" & ChrW(7875) & "u th" & ChrW(7913) & "c " & ChrW(273) & ChrW(243) & "ng kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & "!"
  Case DPSEBlockClosedOutside: rr = "L" & ChrW(7895) & "i d" & ChrW(432) & " d" & ChrW(7845) & "u "")"" " & ChrW(273) & ChrW(243) & "ng nh" & ChrW(243) & "m bi" & ChrW(7875) & "u th" & ChrW(7913) & "c!"
  Case DPSEKeywordNotValid: rr = "K" & ChrW(253) & " t" & ChrW(7921) & " kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & ")"
  Case DPSETwoLockRange: rr = "L" & ChrW(7895) & "i k" & ChrW(253) & " t" & ChrW(7921) & " kh" & ChrW(243) & "a " & ChrW(273) & ChrW(244) & "i trong khai b" & ChrW(225) & "o Range!"
  Case DPSESyntaxError: rr = ""
  Case DPSENumberLongNotValid: rr = "C" & ChrW(250) & " ph" & ChrW(225) & "p s" & ChrW(7889) & " d" & ChrW(224) & "i kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & "!"
  Case DPSESeparatorArray: rr = "D" & ChrW(7845) & "u ph" & ChrW(226) & "n t" & ChrW(225) & "ch gi" & ChrW(225) & " tr" & ChrW(7883) & " m" & ChrW(7843) & "ng kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & "!"
  End Select
 
  If (i - 6) < 0 Then
    ss = Mid$(t, 1, 6) & "...": i2 = i
  ElseIf (i + 10) > l Then
    i2 = 10 - (l - i) + 3: ss = "..." & Right(t, 10)
  Else
    ss = "..." & Mid$(t, i - 6, 12) & "...": i2 = 10
  End If
  errDescription = vbLf & "[Error syntax: " & CStr(ee) & vbLf & _
                    "|  " & rr & IIf(rr = n_, "", vbLf) & _
                    "|  Location: " & i & "" & vbLf & _
                    "|  " & Space(i2 - 1) & "|" & vbLf & _
                    "|  " & Space(i2 - 1) & "v" & vbLf & _
                    "|  " & ss & vbLf & _
                    "]"
End Function


Private Function OfficeVersion(Optional newVersion As Long, Optional implicitIntersectionOperator$, Optional SpillOperator$) As Long

  Static n&, v&, i1$, i2$
  If v <> 0 Then GoTo E
  Dim registryObject As Object
  Dim rootDirectory$
  Dim keyPath$
  Dim arrEntryNames As Variant
  Dim arrValueTypes As Variant

  Select Case Val(Application.Version)
  Case Is >= 16
    i1 = "@"
    Dim x%, p, l%, s$
    For Each p In Interaction.GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery( _
                                            "SELECT name FROM SoftwareLicensingProduct where name like '%office%'", , 48)
      s = p.Name
      For x = 15 To Len(s)
        If Mid$(s, x, 1) Like "#" Then
          l = l + 1
        Else
          If l = 3 Or l = 4 Then
            v = CLng(Mid$(s, x - l, l)):
            If v = 365 Or v >= 2021 Then i2 = "#": n = 1:
            GoTo E
          End If
          l = 0
        End If
      Next x
    Next p

    keyPath = "Software\Microsoft\Office\" & CStr(Application.Version) & "\Common\Licensing\LicensingNext"
    rootDirectory = "."
    Set registryObject = Interaction.GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & rootDirectory & "\root\default:StdRegProv")
    registryObject.EnumValues &H80000001, keyPath, arrEntryNames, arrValueTypes
    On Error GoTo ErrorExit
    For x = 0 To UBound(arrEntryNames)
      If InStr(arrEntryNames(x), "365") > 0 Then i2 = "#": n = 1: v = 365: Exit For
      If InStr(arrEntryNames(x), "2019") > 0 Then v = 2019: n = -1: Exit For
      If InStr(arrEntryNames(x), "2016") > 0 Then v = 2016: n = -1: Exit For
    Next x
  Case Is = 15: n = -1: v = 2013
  Case Is = 14: n = -1: v = 2010 'ProductCode: {91140000-0011-0000-1000-0000000FF1CE} 'CalculationVersion:  145621
  Case Is = 12: n = -1: v = 2007
  Case Else: i2 = "#": i1 = "@": n = 1: v = 2024
  End Select
E:
  newVersion = n: OfficeVersion = v: implicitIntersectionOperator = i1: SpillOperator = i2
Exit Function
ErrorExit:
  v = 2016: n = -1: OfficeVersion = v: newVersion = n
End Function

Add-ins tại bài viết

FormulaBeautifyXL 2.5: Chuyển đổi và định dạng công thức Excel dễ dàng chỉnh sửa

***** SIÊU CẬP NHẬT 2.2 ***** Trình chuyển dấu tách đối số, dấu thập phân, dấu tách mảng Thêm form cài đặt các tùy chọn. Thêm trình tự động kiểm tra phiên bản Add-in mới Sửa và thêm phím tắt **Cập nhật cũ 1.8: Thêm phím tắt Ctrl+Shift+B: để thao tác tay sau khi đã chọn ô nhấn phím tắt thì...

giaiphapexcel.com

 

[Mr.hieudoanxd]

Không đáng là ntn bạn :-? Rất nhiều người cần huỷ làm tròn, chẳng qua không ai biết cách nên mới phải sửa thủ công thoai, độ cần chắc chỉ sau hàm Bằng chữ :sure:

Việc đánh giá đáng hay không đáng là do cá nhân người ta nhận xét. Bác chả có quyền gì phán xét nhận xét của họ cả.
Code trong file chỉ đúng trong trường hợp số chữ số làm tròn sau dấu phảy (hoặc trước) <10. Ngoài ra cú pháp hàm phải đầy đủ ví dụ =ROUND(a1,1) chứ không phải là =ROUND(A1,)
P/S1: Chắc chưa xét hết các trường hợp xẩy ra.....
P/S2: Đến dở hơi, dành ra cả 1 buổi chiều bỏ cả việc ngồi làm mấy cái này......

 

[VetMini]

Không đáng là không đáng phải viết code cao cấp, thử các trường hợp. Người hỏi thì chỉ biết hỏi, chứ đâu có biết hêt những trường hợp rắc rối. Công việc này trở thành nhiệm vụ người viết code.
Rốt cuốc lại, đối với người hỏi thì cái gì lại chẳng xứng đáng, họ có phải động não đâu?

Viết code càng cao cấp thì lại càng cực vì phải chú thích, dẫn giải cách sử dụng.
Người hỏi chỉ việc "A ơi, sao e làm ... ko ra vậy?". Lại hì hục giải thích.

 

[CHAOQUAY]

Như tít , các bác có cách nào xoá toàn bộ làm tròn kể cả round nằm giữa công thức không ạ, hàm round ngay sau dấu = thì dễ chứ nằm giữa công thức thì khó xử lý quá ><

Cái này dễ còn hơn ăn phở. Gửi file mong muốn lên nhé bạn

 

[Decepticon]

Việc đánh giá đáng hay không đáng là do cá nhân người ta nhận xét. Bác chả có quyền gì phán xét nhận xét của họ cả.
Code trong file chỉ đúng trong trường hợp số chữ số làm tròn sau dấu phảy (hoặc trước) <10. Ngoài ra cú pháp hàm phải đầy đủ ví dụ =ROUND(a1,1) chứ không phải là =ROUND(A1,)
P/S1: Chắc chưa xét hết các trường hợp xẩy ra.....
P/S2: Đến dở hơi, dành ra cả 1 buổi chiều bỏ cả việc ngồi làm mấy cái này......

bác í nhận xét vấn đề mình đưa ra không đáng tốn thời gian, kiểu nó rất xàm xì nên mình phản biện chứ mình đâu phán xét. Các trường hợp đơn giản như bác @cantl nêu ra (công việc của mình cũng chỉ cần đến thế) thì mình xử lý được rồi, mình lập topic hỏi cách huỷ làm tròn trong mọi trường hợp vì tò mò muốn tìm hiểu và mình không nghĩ nó xàm xì đến mức không đáng thảo luận, nghiên cứu.

Mình thêm Selection.Replace What:=",)", Replacement:=",0)", LookAt:=xlPart, sửa B1 thành Selection nhưng test thử một số công thức vẫn gặp lỗi chưa bao quát hết được.

P/s: Hàm bằng chữ dài ngoằng xử lý ngon lành mới sợ ))

Cái này dễ còn hơn ăn phở. Gửi file mong muốn lên nhé bạn

Test thử đi bác

 

[CHAOQUAY]

bác í nhận xét vấn đề mình đưa ra không đáng tốn thời gian, kiểu nó rất xàm xì nên mình phản biện chứ mình đâu phán xét. Các trường hợp đơn giản như bác @cantl nêu ra (công việc của mình cũng chỉ cần đến thế) thì mình xử lý được rồi, mình lập topic hỏi cách huỷ làm tròn trong mọi trường hợp vì tò mò muốn tìm hiểu và mình không nghĩ nó xàm xì đến mức không đáng thảo luận, nghiên cứu.

Mình thêm Selection.Replace What:=",)", Replacement:=",0)", LookAt:=xlPart, sửa B1 thành Selection nhưng test thử một số công thức vẫn gặp lỗi chưa bao quát hết được.

P/s: Hàm bằng chữ dài ngoằng xử lý ngon lành mới sợ ))


Test thử đi bác

Bạn muốn xử lý công thức tại ô nào?

 

[Decepticon]

Bạn muốn xử lý công thức tại ô nào?

Tất cả các ô bác ạ, lý tưởng là Ctrl+A hoặc chọn vùng selection, chạy script là toàn bộ hàm làm tròn bay hết luôn

Trong file đính kèm có macro của bác hieudoanxd cũng khá hoàn thiện rồi, mấy ô công thức đơn giản bị lỗi nhưng phức tạp hnó lại xử lý đc

 

[Mr.hieudoanxd]

Tất cả các ô bác ạ, lý tưởng là Ctrl+A hoặc chọn vùng selection, chạy script là toàn bộ hàm làm tròn bay hết luôn

Trong file đính kèm có macro của bác hieudoanxd cũng khá hoàn thiện rồi, mấy ô công thức đơn giản bị lỗi nhưng phức tạp hnó lại xử lý đc

Chưa xử lý trường hợp round(A1, - 1). Nhưng mà có cơ sở chắc sửa không đến nỗi khó. Để chờ món phở của bác Cháo Quẩy xem như thế nào rồi em sửa sau vậy!