[已解决]大神帮忙加个代码实现图片功能功能

透明世界1987

请大神看一下怎么给我加段代码，现在代码可以实现双击名称，J列就会自动变换供应商，现在需要加一个条件，当J列是和昌的时候双击名称才变换供应商，J列是空白或者HC外协，双击名称不发生变化。
工作簿.zip (141.35 KB, 下载次数: 4)

2022-4-20 20:20 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

roserice

2022-4-21 22:59

透明世界1987 发表于 2022-4-21 16:10

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr, brr
Dim i&, k&
If Target.Column <> 3 Then Exit Sub
    arr = Array("井道材料", "导轨", "层门装置(OULING)", "对重块", "侧梁", "对重架", "门机(OULING)", "曳引机(GETM3.0H)", _
        "承重梁", "控制柜", "线系统&安全部件", "钢丝绳", "绳轮", "标准件", "平衡补偿链", "轿门&人机交换", "轿顶、底&上梁", _
        "轿厢装潢", "曳引机(GTW9S)", "轿底配重块", "门机(欧菱)", "曳引机(TORIN)", "轿顶", "机器底座", "厅门&门套&后围壁", _
        "门机(XIZI)", "曳引机(GETM6.0H)", "厅门&门套", "厅门", "曳引机(MONA320B)", "曳引机(MONTANARI)", "Hoistway material井道材料", _
        "Rails导轨", "Hall door device层门装置(OULING)", "CWT block对重块", "CWT frame对重架", "Ceiling &platform&Cross beam轿顶、底&上梁", _
        "Car decoration轿厢装潢", "Gate operator门机(OULING)", "Traction machine曳引机(GETM3.0H)", "Supporting beam承重梁", "Controller控制柜", _
        "Wiring&Safe Parts线系统&安全部件", "Ropes钢丝绳", "Guiding pulley绳轮", "层门装置(XIZI)", "曳引机(GETM3.2D)", "主机底座")
    brr = Array("永德", "西豪", "欧菱", "南南", "永德", "永德", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "永德", "力旭", "富美达", _
        "莱升", "永德", "山明", "甫哥", "南南", "欧菱", "甫哥", "莱升", "利昌", "山明", "优迈", "富沃德", "山明", "山明", "蒙纳", "蒙纳", _
        "永德", "浩圣", "欧菱", "南南", "永德", "永德", "山明", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "兆元", "优迈", "富沃德", "利昌")


    For k = 0 To UBound(arr)
        If (arr(k) = Target.Value) And (Target.Offset(0, 7) = "和昌") Then
            Target.Offset(0, 7) = brr(k): Exit For
        End If
    Next
End Sub

跳转到最佳答案楼层

roserice

自动变换供应商名称,变成什么样的名称呢?代码在哪里呢?没头没尾的问题

透明世界1987

roserice 发表于 2022-4-20 20:40
自动变换供应商名称,变成什么样的名称呢?代码在哪里呢?没头没尾的问题

文件里有的呀 ！这个代码已经设置好了 附件有
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 3 Then Exit Sub
    Dim arr, brr, crr, i&, k&
    arr = Array("井道材料", "导轨", "层门装置(OULING)", "对重块", "侧梁", "对重架", "门机(OULING)", "曳引机(GETM3.0H)", _
        "承重梁", "控制柜", "线系统&安全部件", "钢丝绳", "绳轮", "标准件", "平衡补偿链", "轿门&人机交换", "轿顶、底&上梁", _
        "轿厢装潢", "曳引机(GTW9S)", "轿底配重块", "门机(欧菱)", "曳引机(TORIN)", "轿顶", "机器底座", "厅门&门套&后围壁", _
        "门机(XIZI)", "曳引机(GETM6.0H)", "厅门&门套", "厅门", "曳引机(MONA320B)", "曳引机(MONTANARI)", "Hoistway material井道材料", _
        "Rails导轨", "Hall door device层门装置(OULING)", "CWT block对重块", "CWT frame对重架", "Ceiling &platform&Cross beam轿顶、底&上梁", _
        "Car decoration轿厢装潢", "Gate operator门机(OULING)", "Traction machine曳引机(GETM3.0H)", "Supporting beam承重梁", "Controller控制柜", _
        "Wiring&Safe Parts线系统&安全部件", "Ropes钢丝绳", "Guiding pulley绳轮", "层门装置(XIZI)", "曳引机(GETM3.2D)", "主机底座")
    brr = Array("永德", "西豪", "欧菱", "南南", "永德", "永德", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "永德", "力旭", "富美达", _
        "莱升", "永德", "山明", "甫哥", "南南", "欧菱", "甫哥", "莱升", "利昌", "山明", "优迈", "富沃德", "山明", "山明", "蒙纳", "蒙纳", _
        "永德", "浩圣", "欧菱", "南南", "永德", "永德", "山明", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "兆元", "优迈", "富沃德", "利昌")
    For k = 0 To UBound(arr)
        If arr(k) = Target.Value Then
            Target.Offset(0, 7) = brr(k): Exit For
        End If
    Next
End Sub

roserice

透明世界1987 发表于 2022-4-21 08:19
文件里有的呀 ！这个代码已经设置好了 附件有
Private Sub Worksheet_Change(ByVal Target As Range)
  ...

附件里没见有啊

透明世界1987

roserice 发表于 2022-4-21 14:34
附件里没见有啊

工作簿1.zip (92.52 KB, 下载次数: 3)

2022-4-21 16:10 上传

点击文件名下载附件

roserice

透明世界1987 发表于 2022-4-21 16:10

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr, brr
Dim i&, k&
If Target.Column <> 3 Then Exit Sub
    arr = Array("井道材料", "导轨", "层门装置(OULING)", "对重块", "侧梁", "对重架", "门机(OULING)", "曳引机(GETM3.0H)", _
        "承重梁", "控制柜", "线系统&安全部件", "钢丝绳", "绳轮", "标准件", "平衡补偿链", "轿门&人机交换", "轿顶、底&上梁", _
        "轿厢装潢", "曳引机(GTW9S)", "轿底配重块", "门机(欧菱)", "曳引机(TORIN)", "轿顶", "机器底座", "厅门&门套&后围壁", _
        "门机(XIZI)", "曳引机(GETM6.0H)", "厅门&门套", "厅门", "曳引机(MONA320B)", "曳引机(MONTANARI)", "Hoistway material井道材料", _
        "Rails导轨", "Hall door device层门装置(OULING)", "CWT block对重块", "CWT frame对重架", "Ceiling &platform&Cross beam轿顶、底&上梁", _
        "Car decoration轿厢装潢", "Gate operator门机(OULING)", "Traction machine曳引机(GETM3.0H)", "Supporting beam承重梁", "Controller控制柜", _
        "Wiring&Safe Parts线系统&安全部件", "Ropes钢丝绳", "Guiding pulley绳轮", "层门装置(XIZI)", "曳引机(GETM3.2D)", "主机底座")
    brr = Array("永德", "西豪", "欧菱", "南南", "永德", "永德", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "永德", "力旭", "富美达", _
        "莱升", "永德", "山明", "甫哥", "南南", "欧菱", "甫哥", "莱升", "利昌", "山明", "优迈", "富沃德", "山明", "山明", "蒙纳", "蒙纳", _
        "永德", "浩圣", "欧菱", "南南", "永德", "永德", "山明", "欧菱", "富沃德", "永德", "和昌", "和昌", "通用", "兆元", "优迈", "富沃德", "利昌")


    For k = 0 To UBound(arr)
        If (arr(k) = Target.Value) And (Target.Offset(0, 7) = "和昌") Then
            Target.Offset(0, 7) = brr(k): Exit For
        End If
    Next
End Sub