EXCEL按商品/料号整理拼接库位号-公式函数/VBA

分享：

EXCEL多方法按按商品/料号整理拼接库位号分享

场景：

仓库商品按库位存放，查询商品都存放到了哪些库位（扩展需求：查看库位有哪些商品）。

需求：

根据A列料号一样的料号对应的库位号B列，把B列的库位号自动放到E列上去,且中间空一格

备注：

A列的料号是一样的会放在一起的；且A列料号重复出现的次数不会超过24次；

参考见手工填的范例。

///////////////////////////////////////////////

方法一：辅助列+VLOOKUP

思维逻辑：简化拆解与集成拼装

=IFERROR(VLOOKUP($A2&1,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&2,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&3,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&4,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&5,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&6,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&7,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&8,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&9,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&10,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&11,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&12,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&13,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&14,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&15,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&16,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&17,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&18,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&19,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&20,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&21,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&22,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&23,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&24,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&25,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&26,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&27,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&28,$B:$C,2,0)&"","")&IFERROR(VLOOKUP($A2&29,$B:$C,2,0)&"","")

方法二：OFFSET+PHONETIC

思维逻辑：查找引用与数组拼接

=PHONETIC(OFFSET($E$1,MATCH(A2,A:A,0)-1,0,COUNTIF(A:A,A2),1))

方法三：VBA宏

思维逻辑：输入→处理→输出

///////////////////VBA宏模板///////////////////////

Sub qigemingzi()       '起个名字

'--------------------------------

Sheets("表名").Select  '选中一个表

Dim tms

tms = Timer                                      '获取当前时间

Application.ScreenUpdating = False               '关闭屏幕更新

kshs = 2                                         '定义开始行数

jshs = Sheets("表名").[A65536].End(xlUp).Row     '获取数据行数

jsl = Split(Sheets("表名").[IV3].End(xlToLeft).Address,"$")(1) '获取结束列标字母

ReDim shuchu(1 To jshs, 1 To jsls)           '定义输出数组

'相关数据写入数组

'--------------------------------

Dim shujuarr                                 '定义数据数组

shujuarr = Range("a"& kshs &":a"& jshs)   '列数据装入数组

'字典相关操作样例

'--------------------------------

Dim dic As Object                              '定义字典

Set dic = CreateObject("Scripting.Dictionary") '引用字典

For i = 1 To jshs - 1

   Key = shujuarr(i, 1)

  Item = shujuarr(i, 3)

  If dic.exists(Key) Then                     '判断字典是否存在KEY键

  dic.Item(Key) = dic.Item(Key) &","& Item  '存在则变更KEY对应的值

  Else

  dic.Add Key, Item                           '不存在则添加键值

  End If

Next

For i = 1 To jshs - 1

vkey = shujuarr(i, 2)

shuchu(i) = dic.Item(vkey)                    '查找Vkey返回值。

Next

'输出数组结果回写单元格

'--------------------------------

Range("DC"& kshs &":"& jsl & jshs) = shuchu           '输出数据回写单元格，如需转置则Application.Transpose(shuchu)

Application.ScreenUpdating = True

MsgBox"更新完成,用时"& Format(Timer - tms,"0.0000s")  '计算程序用时

End Sub