一个算价格的程序 求教

vba小白菜阿

想要根据规格尺寸的输入范围，自动输入单价，并算出小计和总价

yanglinzi

是不是这样的。

vba小白菜阿

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
   If Cells(Target.Row, 1) <= 100 And Cells(Target.Row, 1) > 0 Then
      Cells(Target.Row, 2) = 20
   ElseIf Cells(Target.Row, 1) <= 200 And Cells(Target.Row, 1) > 100 Then
      Cells(Target.Row, 2) = 25
   End If
End If
If Target.Row > 1 And Target.Column = 3 Then
   If Cells(Target.Row, 3) = "" Then
      Cells(Target.Row, 4) = ""
   ElseIf Cells(Target.Row, 3) <> "" Then
      Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
   End If
End If
End Sub

vba小白菜阿

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
   If Cells(Target.Row, 1) <= 100 And Cells(Target.Row, 1) > 0 Then
      Cells(Target.Row, 2) = 20
   ElseIf Cells(Target.Row, 1) <= 200 And Cells(Target.Row, 1) > 100 Then
      Cells(Target.Row, 2) = 25
   End If
End If
If Target.Row > 1 And Target.Column = 3 Then
   If Cells(Target.Row, 3) = "" Then
      Cells(Target.Row, 4) = ""
   ElseIf Cells(Target.Row, 3) <> "" Then
      Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
   End If
End If
End Sub

前面几步我自己试着写了一下 测试没有问题 大神看看这个代码有没有问题

vba小白菜阿

yanglinzi 发表于 2021-8-8 16:40
是不是这样的。

你好非常感谢 实现的效果就是这样 不过我想通过VBA的编程实现Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
   If Cells(Target.Row, 1) <= 100 And Cells(Target.Row, 1) > 0 Then
      Cells(Target.Row, 2) = 20
   ElseIf Cells(Target.Row, 1) <= 200 And Cells(Target.Row, 1) > 100 Then
      Cells(Target.Row, 2) = 25
   End If
End If
If Target.Row > 1 And Target.Column = 3 Then
   If Cells(Target.Row, 3) = "" Then
      Cells(Target.Row, 4) = ""
   ElseIf Cells(Target.Row, 3) <> "" Then
      Cells(Target.Row, 4) = Cells(Target.Row, 2) * Cells(Target.Row, 3)
   End If
End If
End Sub

大神 帮我看一下这个代码逻辑或者代码上有没有优化的地方

AmoKat

vba小白菜阿 发表于 2021-8-8 16:44
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
...

Private Sub Worksheet_Change(ByVal Target As Range)
    Set xTarget = Application.Intersect(Target, [A3:C8])
    If xTarget Is Nothing Then Exit Sub
   
    For Each xT In xTarget
        Application.EnableEvents = False  '停止觸發事件
        r = xT.Row: c = xT.Column
        If c = 1 And Cells(r, 1) > 0 Then
            Cells(r, 2) = Application.Lookup(xT, [{0,"";50,20;101,25;201,28;301,""}])
        ElseIf c = 1 Then
            Cells(r, 2) = ""
        End If
        If Cells(r, 2) > 0 And Cells(r, 3) > 0 Then
            Cells(r, 4) = Cells(r, 2) * Cells(r, 3)
         Else
            Cells(r, 4) = ""
        End If
        [d9] = Application.Sum([d3:d8])
        Application.EnableEvents = True   '啟動觸發事件
    Next
End Sub

Sub 啟動觸發事件()
    Application.EnableEvents = True   '啟動觸發事件
End Sub

梦幻的流星

vba小白菜阿

AmoKat 发表于 2021-8-8 21:03
Private Sub Worksheet_Change(ByVal Target As Range)
    Set xTarget = Application.Intersect(Targe ...

大神  首先感谢您的帮助麻烦您再帮我看一下 我把代码放进去，运行不出来结果 到底是什么原因

vba小白菜阿

梦幻的流星 发表于 2021-8-8 21:23

十分感谢您 学习了

vba小白菜阿

大神们帮我看一下这些行代码怎么优化，我测试的是没有问题，每次我试着优化都会提示错误
自学真的是有点吃力了