A列的货品编码合并填到N列对应编码，A列编码类似***-001/**-002，但是N列只有***

sulli112

表格中A列的货品编码跟K列的货品编码是对应的，但是因为规格有正负差，所以可能会出现同一款产品有几个规格，如果像这种情况，我编码一般是14050001-001/14050001-002，但是都是对应K列的14050001，如果遇到这种情况需要将K列的数据合并填到14050001 /N列，请问这种情况要怎么操作呢？函数公式也可以！谢谢
  

xiangbaoan

1. Sub test1() '仅参考
   
2.   Dim ar, Dict As Object, i As Long, y As Long
   
3.   Set Dict = CreateObject("Scripting.Dictionary")
   
4.   ar = Range("K2", Cells(Rows.Count, "k").End(xlUp))
   
5.   For i = 1 To UBound(ar)
   
6.     If Len(CStr(ar(i, 1))) Then Dict(CStr(ar(i, 1))) = i
   
7.   Next
   
8.   ReDim br(1 To i - 1, 1 To 1) As Double
   
9.   ar = Range("A1").CurrentRegion
   
10.   For i = 3 To UBound(ar)
    
11.     If Len(ar(i, 1)) Then
    
12.       y = Dict(Split(ar(i, 1), "-")(0))
    
13.       If y Then br(y, 1) = br(y, 1) + ar(i, 8)
    
14.     End If
    
15.   Next
    
16.   Range("N2").Resize(UBound(br)) = br
    
17.   Set Dict = Nothing
    
18. End Sub

复制代码

sulli112

xiangbaoan 发表于 2021-11-4 13:00

谢谢

sulli112

xiangbaoan 发表于 2021-11-4 13:00

你好，我想问一下，如果我想要修改成当条件一一致时，提取特定列的数据要，修改哪里呢？，你这个代码可以提取文件H列的数据，但是我想改成提取i列的数据要怎么修改呢

xiangbaoan

sulli112 发表于 2021-12-3 21:47
你好，我想问一下，如果我想要修改成当条件一一致时，提取特定列的数据要，修改哪里呢？，你这个代码可以 ...

a——h 1 2 3 4 5 6 7 8
a——i 1 2 3 4 5 6 7 8 9
那么 ar(i, 9)

sulli112

xiangbaoan 发表于 2021-12-4 07:09
a——h 1 2 3 4 5 6 7 8
a——i 1 2 3 4 5 6 7 8 9
那么 ar(i, 9)

谢谢啦，我之前看代码的时候竟然没有没有看到ar(i,8)，被自己蠢哭

xiangbaoan

sulli112 发表于 2021-12-4 08:00
谢谢啦，我之前看代码的时候竟然没有没有看到ar(i,8)，被自己蠢哭

坚强些，别哭

sulli112

1. Sub test1() '仅参考
   
2.   Dim ar, Dict As Object, i As Long, y As Long
   
3.   Set Dict = CreateObject("Scripting.Dictionary")
   
4.   ar = Range("K2", Cells(Rows.Count, "k").End(xlUp)) '需要查找数据的货品编码
   
5.   For i = 1 To UBound(ar)
   
6.     If Len(CStr(ar(i, 1))) Then Dict(CStr(ar(i, 1))) = i
   
7.   Next
   
8.   ReDim br(1 To i - 1, 1 To 1) As Double
   
9.   ar = Range("A1").CurrentRegion '被查到数据的货品编码
   
10.   For i = 3 To UBound(ar)
    
11.     If Len(ar(i, 1)) Then
    
12.       y = Dict(Split(ar(i, 1), "-")(0))
    
13.       If y Then br(y, 1) = br(y, 1) + ar(i, 8) '数据所在列列数
    
14.     End If
    
15.   Next
    
16.   Range("N2").Resize(UBound(br)) = br '数据显示的列数位置
    
17.   Set Dict = Nothing
    
18. End Sub
    

复制代码