|
你发全表吧?如果不方便发到论坛上,你就给QQ号给我,我再看看吧?另外,程序略有修改。Option Explicit
Sub 箱单()
Dim rowshu, columnshu, arr, i, j, n, m, k
Dim d As New Dictionary
Sheets("大货清单").Select
rowshu = Range("A65536").End(xlUp).Row
columnshu = 51 'Range("dz1").End(xlToLeft).Column
arr = Sheets("大货清单").Range(Cells(2, 1), Cells(rowshu, columnshu))
Sheets("装箱单").Select
Range("a1:E" & rowshu).Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(arr)
For j = 4 To UBound(arr, 2) Step 2
If arr(i, j) <> "" Then
If d.Exists(arr(i, j)) = False Then
n = n + 1
d(arr(i, j)) = n
End If
End If
Next j
Next i
'ReDim arr1(1 To UBound(arr), 1 To 5)
n = 0
For m = 0 To d.Count
n = n + 2
With Sheets("装箱单")
.Cells(n - 1, 1) = "(" & m + 1 & "号箱)"
Sheets("装箱单").Select
.Range(.Cells(n - 1, 1), .Cells(n, 5)).Select
Range(Cells(n - 1, 1), Cells(n, 5)).HorizontalAlignment = Excel.xlCenter
.Cells(n - 1, 1).Font.Name = "宋体"
.Cells(n - 1, 1).Font.Size = 14
.Cells(n - 1, 1).Font.Bold = True
.Range(.Cells(n - 1, 1), .Cells(n - 1, 5)).Merge
.Range(.Cells(n - 1, 1), .Cells(n, 5)).Interior.ColorIndex = 2
.Cells(n, 1) = "序号"
.Cells(n, 2) = "货号"
.Cells(n, 3) = "品名"
.Cells(n, 4) = "条形码"
.Cells(n, 5) = "数量"
End With
k = 0
For i = 1 To UBound(arr)
For j = 4 To UBound(arr, 2) Step 2
If arr(i, j) = m + 1 Then
k = k + 1
With Sheets("装箱单")
.Cells(n + k, 5) = arr(i, j + 1)
.Cells(n + k, 1) = k
.Cells(n + k, 2) = arr(i, 1)
.Cells(n + k, 3) = arr(i, 2)
.Cells(n + k, 4) = arr(i, 3)
End With
End If
Next j
Next i
With Sheets("装箱单")
.Cells(n + k + 1, 4) = "合计"
.Range(.Cells(n + k + 1, 4), .Cells(n + k + 1, 5)).Font.Bold = True
.Range(.Cells(n + k + 1, 4), .Cells(n + k + 1, 5)).Font.ColorIndex = 5
.Cells(n + k + 1, 5) = Application.WorksheetFunction.Sum(.Range(.Cells(n + 1, 5), .Cells(n + k, 5)))
Sheets("装箱单").Select
.Range(.Cells(n, 1), .Cells(n + k + 1, 5)).Select
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlHairline
End With
Selection.BorderAround xlContinuous, xlMedium
End With
n = n + k + 3
Next m
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
|
|