|
楼主 |
发表于 2024-10-5 09:41
|
显示全部楼层
Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("源数据")
Dim lastRow As Long
' 遍历所有工作表
For Each ws In ThisWorkbook.Worksheets
With ws
' 假设合计行包含"合计",并且位于最后一行
' 从最后一行开始向上查找,直到找到不包含"合计"的行
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Do While .Cells(lastRow, 1).Value = "合计"
.Rows(lastRow).Delete
lastRow = lastRow - 1
Loop
End With
Next ws
Set wb = ThisWorkbook
Set sht = wb.Sheets("源数据")
Set sh = wb.Sheets("商品数据")
Dim m As Worksheet
Set m = ThisWorkbook.Worksheets("采购单")
m.Range("c1").formula = "=MATCH(""预定合计"",源数据!1:1,0)"
m.Range("d1").formula = "=MATCH(""分拣单位"",源数据!1:1,0)"
arr = sht.[a1].CurrentRegion
brr = sh.[a1].CurrentRegion
ReDim crr(1 To UBound(arr) - 1, 1 To 4)
For i = 2 To UBound(arr)
crr(i - 1, 2) = arr(i, 1)
crr(i - 1, 3) = arr(i, ThisWorkbook.Sheets("采购单").Range("c1").Value)
crr(i - 1, 4) = arr(i, ThisWorkbook.Sheets("采购单").Range("d1").Value)
s = arr(i, 1) & arr(i, ThisWorkbook.Sheets("采购单").Range("d1").Value)
For j = 2 To UBound(brr)
ss = brr(j, 5) & brr(j, 12)
If s = ss Then crr(i - 1, 1) = brr(j, 11)
Next
Next
With wb.Sheets("目标")
.[a1].Resize(, 4) = [{"供应商名称","商品名称","数量","单位"}]
.[A2].Resize(UBound(crr), 4) = crr
End With
m.Range("c1:D2").ClearContents
Beep
End Sub |
|