根据物料编码和仓库代码自动抓取库存，感谢！

wstwfs

如附件，非常感谢！

3190496160

数组+字典的典型案列，先留个记号吧

feilanga

yynrzwh

库存查询示例.rar (33.08 KB, 下载次数: 32)

2023-11-8 16:46 上传

点击文件名下载附件

feilanga

仓库有点儿多，自动输出表头和仓库

3190496160

Sub 统计库存()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("B表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "B表为空！": End
    ar = .Range(.Cells(4, 1), .Cells(r, 4))
End With
y = 2
k = 1
ReDim br(1 To UBound(ar), 1 To 500)
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        t = d(ar(i, 1))
        If t = "" Then
            k = k + 1
             d(ar(i, 1)) = k
             t = k
             br(k, 1) = ar(i, 1)
             br(k, 2) = ar(i, 2)
        End If
        lh = d(ar(i, 3))
        If lh = "" Then
            y = y + 1
            d(ar(i, 3)) = y
            lh = y
            br(1, y) = ar(i, 3)
        End If
        br(t, lh) = br(t, lh) + ar(i, 4)
    End If
Next i
With Sheets("A表")
    .[a1].CurrentRegion.Borders.LineStyle = 0
    .[a1].CurrentRegion = Empty
    .[a1].Resize(k, y) = br
    .[a1].Resize(k, y).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

A表事先不做认真输入
库存查询示例.rar (31.04 KB, 下载次数: 23)

2023-11-8 17:55 上传

点击文件名下载附件

limonet

关键字:left join

limonet

Sub Limonet()
    Dim StrSQL$, StrSQL1$, Cn As Object, Arr As Variant, i%
    Arr = Range(Cells(1, "D"), Cells(1, Cells(1, 16384).End(xlToLeft).Column)).Value
    S = "'" & Join(Application.Transpose(Application.Transpose(Arr)), "','") & "'"
    Set Cn = CreateObject("ADODB.connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL1 = "Select a.*,b.qty From [A表$A:B]a Left Join (Select 物料编码,Sum([可用量(主单位)]) as qty From [B表$A:D]  Where 仓库名称 in(" & S _
                & ") Group By 物料编码)b On a.物料编码=b.物料编码"
    For i = 1 To UBound(Arr, 2)
        StrSQL = "Select 物料编码,Sum([可用量(主单位)]) as qty From [B表$A:D] Where 仓库名称='" & Arr(1, i) & "' Group By 物料编码"
        StrSQL1 = "Select a.*,b.qty From (" & StrSQL1 & ")a Left join (" & StrSQL & ")b On a.物料编码=b.物料编码"
    Next i
    Range("A2").CopyFromRecordset Cn.Execute(StrSQL1)
End Sub

gwjkkkkk

参与一下。。。