从另一份文件读取数据到本文件中

代码小菜鸟

下单工具.zip (188.3 KB, 下载次数: 12)

2023-7-20 08:46 上传

点击文件名下载附件

3190496160

Sub 取数()
Application.ScreenUpdating = False
Dim ar As Variant
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
f = Dir(ThisWorkbook.Path & "\TH23-0713-24五台现代农业测试.xls*")
If f = "" Then MsgBox "找不到TH23-0713-24五台现代农业测试": End
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
br = wb.Worksheets("物料清单").[a1].CurrentRegion
With Sheets("装箱清单")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:f" & r)
End With
wb.Close False
For i = 2 To UBound(br)
    If Trim(br(i, 2)) <> "" Then
        d(Trim(br(i, 2))) = br(i, 8)
    End If
Next i
ReDim arr(1 To UBound(ar), 1 To 13)
For i = 6 To UBound(ar) Step 51
    For s = i To i + 45
        If s <= r Then
            If Trim(ar(s, 2)) <> "" Then
                n = n + 1
                arr(n, 1) = ar(i - 5, 2)
                arr(n, 2) = ar(s, 2)
                arr(n, 3) = ar(s, 3)
                arr(n, 4) = ar(s, 6)
                arr(n, 5) = ar(s, 4)
                arr(n, 7) = ar(s, 5)
                arr(n, 9) = ar(i - 3, 2)
                arr(n, 13) = ar(i - 5, 5)
                arr(n, 8) = d(Trim(ar(i, 2)))
            End If
        End If
    Next s
Next i
With Sheets("处理页")
    .UsedRange.Offset(1) = Empty
    .[b2].Resize(n, 13) = arr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

shiruiqiang

------------------------

3190496160

3190496160

下单工具.rar (222.9 KB, 下载次数: 5)

2023-7-20 10:07 上传

点击文件名下载附件

3190496160

结果为核对，仅供参考，万一有问题再做处理呗

ykcbf1100

附件供参考。。。

ykcbf1100

shiruiqiang 发表于 2023-7-20 10:03
新手路过，好评送花
------------------------

你的取值有误，你再核对一下。

shiruiqiang

ykcbf1100 发表于 2023-7-20 10:23
你的取值有误，你再核对一下。

跟着lz的思路在走

WangDM1991

都是大神，观摩一下