VBA实战——八百库总单制作

2024年9月13日发(作者：)

Sub 八百库总单制作()

Columns("F:F").Select

Columns("A:A").Select

Columns("H:H").Select

yMode = False

Columns("B:B").Select

Columns("E:E").Select

yMode = False

Columns("F:F").Select

Columns("G:G").Select

yMode = False

Shift:=xlToLeft

Columns("G:G").Select

Shift:=xlToLeft

Range("E5").Select

aR1C1 = "=VLOOKUP(RC[-4],'D:百度云同步盘结构式数据库[结构式数

据库-参数]参数'!R2C2:R4700C6,4,0)"

Range("E5").Select

croll Down:=15

Range("E5:E60").Select

aR1C1 = "=VLOOKUP(RC[-4],'D:百度云同步盘结构式数据库[结构式数

据库-参数]参数'!R2C2:R4700C6,4,0)"

croll Down:=-6

pecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("H5").Select

aR1C1 = _

"=IF(ISNA(LOOKUP(1,0/(RC[-5]&RC[-3]=[备注用.xlsx]参数!R2C3:R4700C3&[备注用.xlsx]

参数!R2C5:R4700C5),[备注用.xlsx]参数!R2C6:R4700C6)),"""",LOOKUP(1,0/(RC[-5]&RC[-3]=[备注

用.xlsx]参数!R2C3:R4700C3&[备注用.xlsx]参数!R2C5:R4700C5),[备注用.xlsx]参

数!R2C6:R4700C6))"

Range("H5").Select

ll Destination:=Range("H5:H60"), Type:=xlFillDefault

Range("H5:H60").Select

pecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

croll Down:=-3

Range("G5").Select

yMode = False

aR1C1 = _

"=""账上""&LOOKUP(1,0/(RC[-4]&RC[-2]='D:百度云同步盘[天照物流进出库明细

表.xlsx]2018.10'!R3C1:R4416C1&'D:百度云同步盘[天照物流进出库明细

表.xlsx]2018.10'!R3C4:R4416C4),'D:百度云同步盘[天照物流进出库明细

表.xlsx]2018.10'!R3C8:R4416C8)&""件，""&RC[1]"

Range("G5").Select

ll Destination:=Range("G5:G60"), Type:=xlFillDefault

Range("G5:G60").Select

croll Down:=-18

pecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Columns("H:H").Select

Shift:=xlToLeft

e What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _

:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Columns("A:B").Select

Range("A2").Activate

yMode = False

With

.Name = "宋体"

.Size = 9

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontMinor

End With

yMode = False

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("B9").Select

Columns("A:A").ColumnWidth = 5.88

Columns("B:B").ColumnWidth = 9.5

Columns("B:B").Select

Range("B2").Activate

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Columns("C:C").Select

Range("C2").Activate

Columns("C:C").t

Columns("C:C").Select

Range("C2").Activate

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Columns("D:D").t

Range("D9").Select

Columns("F:F").ColumnWidth = 4.88

Columns("F:F").Select

Range("F2").Activate

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Columns("G:G").Select

Range("G2").Activate

With

.Name = "宋体"

.Size = 10

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontMinor

End With

Range("A5:F6").Select

s(xlDiagonalDown).LineStyle = xlNone

s(xlDiagonalUp).LineStyle = xlNone

With s(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Columns("E:E").Select

= True

Columns("D:D").t

Columns("D:D").Select

Width = 35.13

Columns("G:G").Select

Width = 29.38

Range("A4:F4").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With

.Name = "宋体"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontMinor

End With

= True

Rows("5:6").Select

ght = 20

Range("H11").Select

Rows("5:5").Select

Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Rows("6:6").Select

Rows("5:5").Select

pecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

yMode = False

Range("A5").Select

aR1C1 = "供应商"

Range("B5").Select

aR1C1 = "订单号"

Range("C5").Select

aR1C1 = "物料编码"

Range("D5").Select

aR1C1 = "物料描述"

Range("E5").Select

aR1C1 = "供应商代码"

Range("F5").Select

aR1C1 = "需求量"

Dim arr, i&, R%, Arr1(), Myr&, ks, js, j&

Myr = Cells(, 3).End(xlUp).Row

arr = Range("a1:f" & Myr)

For i = 2 To UBound(arr)

If arr(i, 1) = "供应商" Then

R = R + 1

ReDim Preserve Arr1(1 To R)

Arr1(R) = i

End If

Next

For i = 1 To R

If i <> R Then

js = Arr1(i + 1) - 1

Else

js = UBound(arr)

End If

ks = Arr1(i) + 1

For j = js To ks Step -1

If arr(j, 3) <> "" Then

Cells(j + 1, 1) = "合计"

Cells(j + 1, 6).Formula = "=Sum(R" & ks & "C:R[-1]C)": Exit For

End If

Next

Next

Range("A5:A6").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("G6").Select

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlTop

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

s(xlDiagonalDown).LineStyle = xlNone

s(xlDiagonalUp).LineStyle = xlNone

With s(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With s(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

ommunication = False

With tup

.PrintTitleRows = ""

.PrintTitleColumns = ""

End With

ommunication = True

rea = ""

ommunication = False

With tup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = ToPoints(0.25)

.RightMargin = ToPoints(0.25)

.TopMargin = ToPoints(0.39)

.BottomMargin = ToPoints(0.39)

.HeaderMargin = ToPoints(0.3)

.FooterMargin = ToPoints(0.3)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintSheetEnd

.PrintQuality = 180

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlPortrait

.Draft = False

.PaperSize = 123

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

.PrintErrors = xlPrintErrorsDisplayed

.OddAndEvenPagesHeaderFooter = False

.DifferentFirstPageHeaderFooter = False

.ScaleWithDocHeaderFooter = True

.AlignMarginsHeaderFooter = True

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

End With

ommunication = True

ommunication = False

With tup

.PrintTitleRows = ""

.PrintTitleColumns = ""

End With

ommunication = True

rea = ""

ommunication = False

With tup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = ToPoints(0.25)

.RightMargin = ToPoints(0.25)

.TopMargin = ToPoints(0.75)

.BottomMargin = ToPoints(0.75)

.HeaderMargin = ToPoints(0.3)

.FooterMargin = ToPoints(0.3)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintSheetEnd

.PrintQuality = 180

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlPortrait

.Draft = False

.PaperSize = 123

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

.PrintErrors = xlPrintErrorsDisplayed

.OddAndEvenPagesHeaderFooter = False

.DifferentFirstPageHeaderFooter = False

.ScaleWithDocHeaderFooter = True

.AlignMarginsHeaderFooter = True

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

End With

ommunication = True

ommunication = False

With tup

.PrintTitleRows = ""

.PrintTitleColumns = ""

End With

ommunication = True

rea = ""

ommunication = False

With tup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = ToPoints(0.25)

.RightMargin = ToPoints(0.25)

.TopMargin = ToPoints(0.75)

.BottomMargin = ToPoints(0.75)

.HeaderMargin = ToPoints(0.3)

.FooterMargin = ToPoints(0.3)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintSheetEnd

.PrintQuality = 180

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlPortrait

.Draft = False

.PaperSize = 123

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = 100

.PrintErrors = xlPrintErrorsDisplayed

.OddAndEvenPagesHeaderFooter = False

.DifferentFirstPageHeaderFooter = False

.ScaleWithDocHeaderFooter = True

.AlignMarginsHeaderFooter = True

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

. = ""

End With

ommunication = True

Dim cpk

For cpk = 6 To 200 Step 1

If Cells(cpk, 1) <> "" Then

Rows("6:6").Select

Rows(cpk & ":" & cpk).Select

pecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

yMode = False

End If

Next

End Sub