求助一个宏

zq5028819

再弄价格，需要对配置进行加价，做一个简单的宏，请求帮助
例：
YE3-100L-4 NSK   120
YE3-200L-4 NSK   150
YE3-300L-4 NSK  180


检索关键字是100，200，300
100就在120基础上+50元
200就在150基础上+60元
300就在180基础上+70元
最后变成
YE3-100L-4 NSK   120       170
YE3-200L-4 NSK   150     210
YE3-300L-4 NSK  180      250



感谢~

NadrsSaber

这个好做, 但是你也没附件文件, 叫人咋帮你啊

zq5028819

NadrsSaber 发表于 2020-2-19 12:26
这个好做, 但是你也没附件文件, 叫人咋帮你啊

已传附件，感谢~

zhenghui13

大概写了一下，请查看。有个问题是现在我只认为型号值是3位的，如果是不定位需要重新考虑。

shenjianrong163

zq5028819 发表于 2020-2-19 12:41
已传附件，感谢~

你的价格就这几种吗?

shenjianrong163

1. Sub test()
   
2.     Dim i, r, arr
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.         arr = .Range("A2:C" & r)
   
6.         For i = 1 To UBound(arr)
   
7.             If InStr(arr(i, 1), "100") <> 0 Then
   
8.                 arr(i, 3) = arr(i, 2) + 50
   
9.             ElseIf InStr(arr(i, 1), "200") <> 0 Then
   
10.                 arr(i, 3) = arr(i, 2) + 60
    
11.             ElseIf InStr(arr(i, 1), "300") <> 0 Then
    
12.                 arr(i, 3) = arr(i, 2) + 70
    
13.             End If
    
14.         Next
    
15.         .Range("A2:C" & r).ClearContents
    
16.         .[A2].Resize(UBound(arr), 3) = arr
    
17.     End With
    
18. End Sub

复制代码

shenjianrong163

请参考附件：
附件.rar (11.43 KB, 下载次数: 1)

2020-2-19 13:26 上传

点击文件名下载附件
1

orr89

Sub 改价格()
    关键字 = Array("100L", "200L", "300L")
    价格 = Array(50, 60, 70)
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    For a = 1 To 3
        If Not dic.exists(关键字(a - 1)) Then dic(关键字(a - 1)) = 价格(a - 1)
    Next
    arr = Range("a2:c" & [a60000].End(xlUp).Row)
    ReDim brr(1 To UBound(arr), 1 To 1)
    For a = 1 To UBound(arr)
        提取 = Split(arr(a, 1), "-")
        If dic.exists(提取(1)) Then brr(a, 1) = dic(提取(1)) + arr(a, 2)
    Next
    [c2].Resize(UBound(brr), 1) = brr
End Sub
'对了请给朵小花

素心1218

[/quote][quote]提取 = Split(arr(a, 1), "-")

这句好经典！