|
|
楼主 |
发表于 2024-10-6 01:11
|
显示全部楼层
改了一下还是运行错误
Sub TEST0()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("源数据2")
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("源数据2")
Set sH = wb.Sheets("商品数据")
Dim m As Worksheet
Set m = ThisWorkbook.Worksheets("采购单")
Set n = ThisWorkbook.Worksheets("采购单")
m.Range("c1").formula = "=MATCH(""预定合计"",源数据2!1:1,0)"
m.Range("d1").formula = "=MATCH(""分拣单位"",源数据2!1:1,0)"
n.Range("e1").formula = "=MATCH(CHAR(1),目标!A:A,-1)+1"
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
'n = ThisWorkbook.Sheets("采购单").Range("e1").Value + 1
'With wb.Sheets("目标")
With ThisWorkbook.Sheets("采购单")
n = .Range("e1").Value + 1
.[A1].Resize(, 4) = [{"供应商名称","商品名称","数量","单位"}]
'.[A2].Resize(UBound(crr), 4) = crr
.Range(a & n).Resize(UBound(crr), 4) = crr
End With
m.Range("c1:e2").ClearContents
Beep
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-10-5 22:09
发表于 2024-10-6 00:46
