请老师帮写份VBA代码，

tanghanping2011

成形工艺表格.zip (236.01 KB, 下载次数: 11)

2024-9-5 15:06 上传

点击文件名下载附件

各位老师：
                    见附件和附 图，请各位老师帮写VBA代码，达到图示要求。
                    拜谢各位老师了！

大灰狼1976

未测试

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Address(0, 0) <> "Y11" Then Exit Sub
   
3. Application.EnableEvents = False
   
4. Dim n!
   
5. n = (5 - Right(Target, 1)) * 0.2
   
6. If n = 0 Then n = 0.1
   
7. Target.Offset(-1) = Target.Offset(-1) * n
   
8. Application.EnableEvents = True
   
9. End Sub

复制代码

tanghanping2011

大灰狼1976 发表于 2024-9-5 16:11
未测试

非常感谢版主老师

现在我在“Y11”调到“困气1”，“困气2”等时，“Y10”是可以跟着计算变化的。
但如果我从“困气2”调 回“困气1”时，希望“Y10”也能跟着计算变回原数。
请老师再辛苦给完善一下。
万分感谢1

大灰狼1976

哦，那还要加上变化前后的数字判断，来选择使用乘法还是除法，现在没有时间，基本上就是通过selectionchange事件获取变化前的尾数字，通过change事件获取变化后的尾数据，通过大小判断使用哪个计算方式及比例。

蓝桥玄霜

工艺的例子：

Qs18

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Address(0, 0) <> "Y11" Then Exit Sub
   
3. Application.EnableEvents = False
   
4. Dim ar, i, dic
   
5. Sheet1.[y10] = "=(VLOOKUP($BQ$7,胶料性能表!$A$1:$AA$416,20,FALSE))"
   
6. t = Sheet1.[y10]
   
7. Set dic = CreateObject("scripting.dictionary")
   
8. ar = [{"困气1",0.8;"困气2",0.6;"困气3",0.4;"困气4",0.2;"困气5",0.1}]
   
9. For i = 1 To UBound(ar)
   
10.     dic(ar(i, 1)) = ar(i, 2)
    
11. Next
    
12. s = Sheet1.Range("y11").Value
    
13. Sheet1.[y10] = t * dic(s)
    
14. Application.EnableEvents = True
    
15. End Sub

复制代码

Qs18

试试..................

Qs18

试试...........

yimeier5

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim vLookupResult As Variant
   
3.     Dim multiplier As Double
   
4.     Dim multipliers As Variant
   
5.     Dim i As Long
   
6.     Dim dict As Object
   
7.       
   
8.     If Not Intersect(Target, Me.Range("Y11")) Is Nothing Then
   
9.         Application.EnableEvents = False
   
10.          
    
11.         Set dict = CreateObject("Scripting.Dictionary")
    
12.         multipliers = Array("困气1", 0.8, "困气2", 0.6, "困气3", 0.4, "困气4", 0.2, "困气5", 0.1)
    
13.         For i = LBound(multipliers) To UBound(multipliers) Step 2
    
14.             dict(multipliers(i)) = multipliers(i + 1)
    
15.         Next i
    
16.          
    
17.         On Error Resume Next
    
18.         vLookupResult = Application.WorksheetFunction.VLookup(Me.Range("BQ7").Value, ThisWorkbook.Sheets("胶料性能表").Range("$A$1:$AA$416"), 20, False)
    
19.         If err.Number <> 0 Then
    
20.             MsgBox "未找到对应的值"
    
21.             Application.EnableEvents = True
    
22.             Exit Sub
    
23.         End If
    
24.         On Error GoTo 0
    
25.          
    
26.        If dict.exists(Me.Range("Y11").Value) Then
    
27.             multiplier = dict(Me.Range("Y11").Value)
    
28.             Me.Range("Y10").Value = vLookupResult * multiplier
    
29.         Else
    
30.             MsgBox "Y11中的值不在预定义的乘数列表中"
    
31.         End If
    
32.          
    
33.         Application.EnableEvents = True
    
34.     End If
    
35. End Sub

复制代码

tanghanping2011

Qs18 发表于 2024-9-5 17:35
试试..................

感谢老师！
如“Y11”处是空白，不显示“困气1~5”时，“Y10”处数据要等于回原“45”。
另：
         当我选择“DZ9”的不同材料时，“Y10”处VLOOKUP搜寻传回的数值也是要同样变化的。
请老师再辛苦辛苦！