[已解决]添加逻辑判断

lidayu

请老师帮助，在这代码中添加一条判断，详见附件

添加判断.rar (104.57 KB, 下载次数: 3)

2021-1-11 08:02 上传

点击文件名下载附件

注：可以把代码中的“

岗石M,花岗岩M,大理石M”

去掉，另外添加一段。

在红色部分添加

If target.Column = 10 Then
     Dim r, X, sl
     r = target.Row
   

If InStr(",路延石,花线,踢脚线,栏杆,开槽,开罗马槽,背钢筋,磨边,岗石M,花岗岩M,大理石M,", "," & Cells(r, 4) & ",") Then
         Cells(r, 13) = Format(Val(Cells(r, 8)) * Val(Cells(r, 10)) / 1000, "0.00") & "m" 'M列小数点后保留二位（四舍五入）
         If Val(Cells(r, 8)) * Val(Cells(r, 10)) = 0 Then Cells(r, 13) = ""   '单元格等于0显示为空

        ElseIf InStr("辅材", Cells(r, 4)) Then
            If Right(Cells(r, 5), 2) = "水泥" Then Cells(r, 13) = Cells(r, 10) & "包"
            If InStr(",黄沙,石子,", "," & Cells(r, 5) & ",") Then Cells(r, 13) = Cells(r, 10) & "吨"
            If Right(Cells(r, 5), 1) = "胶" Then Cells(r, 13) = Cells(r, 10) & "瓶"
        ElseIf InStr(",钻孔,挖洞,", "," & Cells(r, 4) & ",") Then Cells(r, 13) = Cells(r, 10) & "个"
         If Cells(r, 13) = 0 Then Cells(r, 13) = ""
     ElseIf InStr(",大理石,花岗石,花岗岩,岗石,", "," & Cells(r, 4) & ",") Then
         Cells(r, 13) = Format(Val(Cells(r, 8)) * Val(Cells(r, 9)) * Val(Cells(r, 10)) / 1000000, "0.0000") & "㎡"
         If Val(Cells(r, 8)) * Val(Cells(r, 9)) * Val(Cells(r, 10)) = 0 Then Cells(r, 13) = ""
          Else
     End If
     End If
End If
End Sub

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-1-10 23:51

lidayu 发表于 2021-1-14 14:26
zjdh老师您好，代码经过另一个老师提示，我把写成如下，请老师帮我看看红框部分能否简洁点。

ElseIf Right(Cells(r,4),1) = "M" Then

k = WorksheetFunction.Ceiling(Cells(r, 9) / 100, 1)
k = WorksheetFunction.Max(2, k)
If k > 10 Then k = 12
k = k * 0.5

Cells(r,13) = Format(Val(Cells(r,8)) * Val(Cells(r,10)) * k / 1000,"0.00")&"m"

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

lidayu 发表于 2021-1-14 14:26
zjdh老师您好，代码经过另一个老师提示，我把写成如下，请老师帮我看看红框部分能否简洁点。

ElseIf Right(Cells(r,4),1) = "M" Then

k = WorksheetFunction.Ceiling(Cells(r, 9) / 100, 1)
k = WorksheetFunction.Max(2, k)
If k > 10 Then k = 12
k = k * 0.5

Cells(r,13) = Format(Val(Cells(r,8)) * Val(Cells(r,10)) * k / 1000,"0.00")&"m"

祝順心，南無阿彌陀佛！

zjdh

If InStr(",路延石,花线,踢脚线,栏杆,开槽,开罗马槽,背钢筋,磨边,", "," & Cells(r, 4) & ",") Or InStr("M", Right(Cells(r, 4), 1)) Then

lidayu

zjdh 发表于 2021-1-14 13:21
If InStr(",路延石,花线,踢脚线,栏杆,开槽,开罗马槽,背钢筋,磨边,", "," & Cells(r, 4) & ",") Or InStr("M ...

zjdh老师您好，代码经过另一个老师提示，我把写成如下，请老师帮我看看红框部分能否简洁点。

lidayu

cutecpu 发表于 2021-1-14 14:56
ElseIf Right(Cells(r,4),1) = "M" Then

k = WorksheetFunction.Ceiling(Cells(r, 9) / 100, 1)

cutecpu

老师您好，完美实现，老师好强大，感谢您的帮助。

lidayu

cutecpu 发表于 2021-1-10 23:51
ElseIf Right(Cells(r,4),1) = "M" Then

k = WorksheetFunction.Ceiling(Cells(r, 9) / 100, 1)

cutecpu

老师您好，如果是这样图片这样（200进制）代码要怎么调整，请指教。
是把k = WorksheetFunction.Ceiling(Cells(r, 9) / 100, 1)红色的1表示10进制，我改为2对吗？

cutecpu

lidayu 发表于 2021-1-14 18:05
cutecpu老师您好，如果是这样图片这样（200进制）代码要怎么调整，请指教。
是把k = WorksheetFunction. ...

k = WorksheetFunction.Ceiling(Cells(r, 9) / 200, 1)
If k > 5 Then k = 6
Cells(r,13) = Format(Val(Cells(r,8)) * Val(Cells(r,10)) * k / 1000,"0.00")&"m"


祝順心，南無阿彌陀佛！

lidayu

cutecpu 发表于 2021-1-14 19:45
k = WorksheetFunction.Ceiling(Cells(r, 9) / 200, 1)
If k > 5 Then k = 6
Cells(r,13) = Format(Val ...

cutecpu

老师您好，感谢您的帮助。