求助各位大佬写个VBA

求助各位把设备明细表中柜号对应的型号规格数量依次批量复制到工作表“明细”行“元件名称”与行“箱体之间的列C列D列E区域的单元格中这个可能有点难度谢谢各位了

给💰秒解决

不感兴趣

开通SVIP免广告

怎么交易

文件保存到网盘，发上来

要先确认：
1、你是要把【设备明细表】所有的柜号都生成明细，还是【明细】表里你自己设置一部分柜号，然后去【设备明细表】匹配相应的数据。
2、为什么【设备明细表】里对应的产品没有单价，建议多添加一列单价，这样你就不用每次都去输入了。

行数做之前都设置成比要复制的对应多几行吧

Sub demo()
Dim arr, brr, dic As Object, i%, j%, n%, lastRow%, temp
arr = Sheets("设备明细表").Range("a3").CurrentRegion
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If arr(i, 2) <> "" Then
n = Sheets("设备明细表").Cells(i + 2, 1).MergeArea.Rows.Count
brr = Sheets("设备明细表").Cells(i + 2, 4).Resize(n, 3)
dic(arr(i, 2)) = brr
End If
Next i
lastRow = Sheets("明细").UsedRange.Rows.Count
For i = 1 To lastRow
If Sheets("明细").Cells(i, 1) = "柜号" Then
If dic.exists(Sheets("明细").Cells(i, 2).Value) Then
brr = dic(Sheets("明细").Cells(i, 2).Value)
If UBound(brr) > 15 Then Sheets("明细").Rows(i + 3).Resize(UBound(brr) - 15).Insert
Sheets("明细").Cells(i + 2, 3).Resize(UBound(brr), 3) = brr
End If
End If
Next i
MsgBox "处理完成!"
End Sub

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！

11回复贴，共1页

<<返回excel吧

分享到:

日	一	二	三	四	五	六