[xin code VBA]Diễn giải khối lượng

[dcmn1994]

em chào các bác ạ, các bác có code excel nào mà diễn giải khối lượng nghiệm thu không ạ.

Kiểu như thế này ạ

 

[VetMini]

Bạn đã có code rồi, bi giờ chỉ hỏi cách code chú vào công việc ấy? Hay là xin cả một đống từ a đến z?

 

[bebo021999]

Dùng UDF nhé bạn?
Nếu muốn diễn giải bằng chuỗi gồm các giá trị C tới G nối với nhau qua dấu "*"
Chỉ áp dụng cho hàm PRODUCT thôi
tại K129:
=diengiai(C129:G129)

Code:

Option Explicit
Function diengiai(ByVal vung As Range)
Dim cell As Range, st As String
st = "="
For Each cell In vung
    If Not IsEmpty(cell) And cell <> 0 Then st = st & "*" & cell.Value
Next
diengiai = Replace(st, "=*", "=")
End Function

Save file dạng .xlsm

 

[VetMini]

Cái này mà cũng dùng VBA là nhỏng nhẻo quen rồi nên không chịu tìm hiểu thêm về Excel.
Insert một cột tạm kế 3 cột dữ liệu kia, gõ:
'=2.2*3.2*0.1
Flash fill
Kéo cột qua chỗ cột chỉ định.
Xong.

Siêng thì tự động não làm việc. Lười thì lên GPE xin code. Dân văn phòng bi giờ chọn phương án 2.

 

[Mutants Men]

em chào các bác ạ, các bác có code excel nào mà diễn giải khối lượng nghiệm thu không ạ.
View attachment 292861
Kiểu như thế này ạ

t không rành cót két cho lắm chỉ được như vậy, bạn tham khảo xem giúp ích được gì không nha

Option Explicit
'------------------------------------------------------------
' Procedure : funDienGiai
' Author    : Admin
' Date      : 10/09/2020
' Purpose   : Ham dien giai
'------------------------------------------------------------
Public Function funDienGiai(ByVal Rns As Range) As String
    Dim KQ As String, txt As String
    Dim Rn As Range
    For Each Rn In Rns
        txt = "": txt = DienGiai(Rn)
        If Len(txt) > 0 Then
            If Left(txt, 1) = "(" Then
                txt = Mid(txt, 2, Len(txt) - 2)
                If InStr(txt, "(") > 0 Then
                    txt = "[" & txt & "]"
                Else
                    If IsNumeric(txt) Then
                        If CLng(txt) > 0 Then
                            txt = txt
                        Else
                            txt = "(" & txt & ")"
                        End If
                    Else
                        txt = "(" & txt & ")"
                    End If
                End If
            Else
                txt = Round(cNum(txt), 3)
            End If
        End If
        If Len(KQ) = 0 And Len(txt) > 0 Then
            KQ = KQ & txt
        ElseIf Len(txt) > 0 Then
            KQ = KQ & " x" & txt
        End If
    Next
    funDienGiai = KQ
GiaiPhongBien:
    On Error Resume Next
    Set Rn = Nothing
    On Error GoTo 0
End Function
Public Function DienGiai(ByVal Rn As Range) As String
    Dim txt As String, txt2 As String, i As Long, Arr2 As Variant, Arr As Variant
    txt = Rn.Formula
    Select Case True
        Case InStr(txt, "SUM") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "ROUND") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "AVERAGE") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "ABS") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "SIN") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "COS") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "INT") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "POWER") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "RAND") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "PRODUCT") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "SUBTOTAL") > 0: DienGiai = Rn.Value2:    GoTo Thoat
        Case InStr(txt, "SQRT") > 0: DienGiai = Rn.Value2:    GoTo Thoat
    End Select
    DienGiai = txt
    If Left(DienGiai, 1) = "=" Then DienGiai = Mid(DienGiai, 2, Len(DienGiai))
    If Left(DienGiai, 1) = "+" Then DienGiai = Mid(DienGiai, 2, Len(DienGiai))
    txt2 = "()[]+-*/="
    For i = 1 To Len(txt2)
        If InStr(txt, Mid(txt2, i, 1)) > 0 Then txt = Trim(Replace(txt, Mid(txt2, i, 1), " "))
    Next i
    Do
        txt = Trim(Replace(txt, "  ", " "))
        If InStr(txt, "  ") = 0 Then Exit Do
    Loop
    Arr2 = Split(txt, " ")
    Arr = Arr2
    For i = 0 To UBound(Arr)
        If IsCell(Arr(i)) Then
            Arr2(i) = DienGiai(Rn.Worksheet.Range(Arr(i)))
        Else
            If Round(cNum(Arr2(i)), 2) = 0 Then
                Arr2(i) = Round(cNum(Arr2(i)), 3)
            Else
                Arr2(i) = Round(cNum(Arr2(i)), 2)
            End If
        End If
    Next i
    For i = 0 To UBound(Arr2)
        DienGiai = Replace(DienGiai, Arr(i), Arr2(i))
    Next i
    For i = 1 To Len(txt2)
        If InStr(DienGiai, Mid(txt2, i, 1)) > 0 Then
            DienGiai = "(" & Replace(DienGiai, "*", " x") & ")"
            GoTo Thoat
        End If
    Next i
Thoat:
GiaiPhongBien:
    On Error Resume Next
    Erase Arr2
    Erase Arr
    On Error GoTo 0
End Function
Function IsCell(ByVal Rn_Address) As Boolean 'ham kiem tra dia chi cung cap phai la 1 o du lieu ko
    On Error GoTo Loi
    Dim RangeToCheck As Range
    Select Case TypeName(Rn_Address)
        Case "Range"
            Set RangeToCheck = Rn_Address
        Case "String", "TextBox"
            Set RangeToCheck = Range(Rn_Address)
    End Select
    IsCell = RangeToCheck.Cells.Count = 1
    Set RangeToCheck = Nothing
    Exit Function
Loi:
    IsCell = False
    Set RangeToCheck = Nothing
End Function
Public Function cNum(Num):    cNum = Replace(Num, ".", ","):    End Function