Làm ơn viết giùm mình macro làm tròn giá trị ạ (1 người xem)

[namphong126087]

Mong các bạn hỗ trợ ạ
Mình có một ô đang có công thức tính toán ra chữ số thập phân. Giờ mình muốn khi chạy macro, ô đó sẽ thêm công thức làm tròn =Round(...;2) vào ô đó.
Mình thử mãi mà không được. Mong các bạn giúp ạ.
Ví dụ ô của mình là ô A1 đang có công thức là: =70/45
Giờ mình muốn sau khi chạy nó sẽ thành: =round(70/45;2)
Cảm ơn các bạn!

 

[Hoàng Tuấn 868]

Mình thử mãi mà không được. Mong các bạn giúp ạ.

Cái file bạn đã "thử mãi mà không được" ấy đâu, đưa lên đây biết đâu nó lại được.

 

[namphong126087]

Sub InsertRoundFormula()
Dim selectedCell As Range
Dim decimalPlaces As Integer
Dim cellValue As Double
If TypeName(Selection) = "Range" Then
decimalPlaces = InputBox("Enter the number of decimal places to round to:", "Set Decimal Places", 2)
For Each selectedCell In Selection
If IsNumeric(selectedCell.Value) Then
cellValue = selectedCell.Value
selectedCell.Formula = "=ROUND(" & cellValue & "," & decimalPlaces & ")"
End If
End Sub

Mình dùng cái này ạ

 

[Hoàng Tuấn 868]

Sub InsertRoundFormula()
Dim selectedCell As Range
Dim decimalPlaces As Integer
Dim cellValue As Double
If TypeName(Selection) = "Range" Then
decimalPlaces = InputBox("Enter the number of decimal places to round to:", "Set Decimal Places", 2)
For Each selectedCell In Selection
If IsNumeric(selectedCell.Value) Then
cellValue = selectedCell.Value
selectedCell.Formula = "=ROUND(" & cellValue & "," & decimalPlaces & ")"
End If
End Sub

Mình dùng cái này ạ

Bạn có biết cái nào gọi là "File" không.

 

[SA_DQ]

Sub InsertRoundFormula()
    Dim selectedCell As Range
    Dim decimalPlaces As Integer
    Dim cellValue As Double

1    If TypeName(Selection) = "Range" Then
        decimalPlaces = InputBox("Enter the number of decimal places to round to:", "Set Decimal Places", 2)
 3       For Each selectedCell In Selection
            If IsNumeric(selectedCell.Value) Then
                cellValue = selectedCell.Value
                selectedCell.Formula = "=ROUND(" & cellValue & "," & decimalPlaces & ")"
            End If
      'Next  ?????'
 'End If     ?????????????????'
End Sub

Mình dùng cái này ạ

Sao bạn có thể dùng nó được vậy, ban hay thiệt đó nha!

 

[ptm0412]

Thiếu Next và thiếu 1 End If. Nếu viết thò ra thụt vào như thế này thì đã phát hiện sớm rồi.

Sao bạn có thể dùng nó được vậy, ban hay thiệt đó nha!

Nếu bổ sung cái thiếu thiếu vào thì sẽ hay

Bạn có biết cái nào gọi là "File" không.

Code này thì cần gì file.

 

[ptm0412]

Nếu muốn giữ lại công thức cũ, chỉ bọc Round bên ngoài thì thay
cellValue = selectedCell.Value
thành
cellValue = Replace(selectedCell.Formula, "=", "")

Tất nhiên cellValue phải khai báo kiểu String

 

[befaint]

Bài #1 và #3 khác nhau rất rõ.
Bài #6 chưa chắc đã đúng, vì hình chụp không hiện đủ code.

 

[Hoàng Tuấn 868]

Bài #1 và #3 khác nhau rất rõ.
Bài #6 chưa chắc đã đúng, vì hình chụp không hiện đủ code.

Chính vì thế nên em mới bảo gửi file lên cho chắc ăn anh ạ.

 

[ptm0412]

Bài #1 và #3 khác nhau rất rõ.
Bài #6 chưa chắc đã đúng, vì hình chụp không hiện đủ code.

Bài 1 muốn như thế mà làm như bài 3 "mãi không được". Vì thực hiện khác mong muốn nên mới không được.

Bài 6 chỉ chụp hình chỗ cần thiết. Thêm phần bị thiếu chỗ nào thì chỉ chụp hình chỗ đó.
Chắc cũng không cần khoanh đỏ chỗ bổ sung chứ nhỉ?



Bài 6 cũng chưa chắc đúng vì chỉ sửa chỗ VBA mắng và không chịu chạy, chưa sửa chỗ kết quả không như mong muốn. Bài 7 đã nhắc.

 

[ptm0412]

Chính vì thế nên em mới bảo gửi file lên cho chắc ăn anh ạ.

Thì cứ làm như bài 1: gõ =70/45 ở 1 ô bất kỳ ở 1 file bất kỳ là có file. Chỉ sợ không có code bài 3 thôi

 

[Hoàng Tuấn 868]

Thì cứ làm như bài 1: gõ =70/45 ở 1 ô bất kỳ ở 1 file bất kỳ là có file. Chỉ sợ không có code bài 3 thôi

Em có bảo bạn ấy là gửi file "làm mãi mà không được" lên để xem code. Nếu gửi file mà không kèm code thì cũng vô nghĩa, coi như chưa gửi.

 

[ptm0412]

Em có bảo bạn ấy là gửi file "làm mãi mà không được" lên để xem code. Nếu gửi file mà không kèm code thì cũng vô nghĩa, coi như chưa gửi.

Bài 3 đã gởi code, bài 4 vẫn đòi file (lần 2) nên tôi mới nói. Mà thôi.

 

[befaint]

Tới bài #13 vẫn chưa phát hiện ra điểm quan trọng.

 

[ptm0412]

Tới bài #13 vẫn chưa phát hiện ra điểm quan trọng.

Là dấu chấm phẩy chứ gì? Chạy code bài 7 thấy sai thì tự sửa. Máy tôi không xài dấu đó nên bỏ qua không thử. Mà cũng không sai, mới test xong). Dù máy có dấu gì thì VBA cũng cứ viết là phẩy. Đưa xuống sheet thì Excel tự đổi.

 

[Decepticon]

1/ code làm tròn:

 Sub LamTron()
    Dim ws As Worksheet
    Dim roundOption As Variant
    Dim cell As Range
    Dim formulaStr As String
    Dim targetRange As Range
    Dim i As Long, j As Long
    Dim formulas As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set ws = ActiveSheet
If Selection.Cells.Count = 1 And Selection.Areas.Count = 1 Then
Set targetRange = ws.UsedRange
    Else
Set targetRange = Selection
    End If

roundOption = Application.InputBox("Nhap tuy chon cho ROUND (vi du: 0):", "Tuy chon ROUND", Type:=2)

If roundOption = False Then Exit Sub
If roundOption = "" Then roundOption = "0"

If Selection.Cells.Count <= 1 And Selection.Areas.Count = 1 Then
MsgBox "Ban phai chon vung moi duoc thuc thi", vbExclamation
        Exit Sub
    End If

formulas = targetRange.formula

For i = 1 To UBound(formulas, 1)
For j = 1 To UBound(formulas, 2)
If Left(formulas(i, j), 1) = "=" And _
InStr(formulaStr, "=ROUND") = 0 And _
InStr(formulaStr, "=+ROUND") = 0 And _
InStr(formulaStr, "=-ROUND") = 0 Then
formulas(i, j) = Replace(formulas(i, j), "=", "=ROUND(", , , vbTextCompare)
formulas(i, j) = formulas(i, j) & "," & roundOption & ")"
            End If
        Next j
    Next i

targetRange.formula = formulas

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Xu ly xong!", vbInformation
End Sub

2/ code Huỷ làm tròn:
xem ở đây: https://www.giaiphapexcel.com/diend...àn-bộ-làm-tròn-round-roundup-rounddown.171123

 

[namphong126087]

Cảm ơn các bác ạ!