GuGift.cn

Dim mth1, mth2, mth3, mth4, mth5, mth6
Sub 全局变量()
mth1 = Sheet1.Cells(4, 7).Value
mth2 = Sheet1.Cells(4, 15).Value
mth3 = Sheet1.Cells(4, 23).Value
mth4 = Sheet1.Cells(4, 31).Value
mth5 = Sheet1.Cells(4, 39).Value
mth6 = Sheet1.Cells(4, 47).Value
End Sub

Sub 文件合并()
'Application.ScreenUpdating = False
On Error Resume Next
Dim wb As Workbook, sh As Worksheet
Dim fn As String, pt As String, t
t = Timer
'------------------------检测是否打开了多个excel文件-------------------
If Workbooks.Count > 1 Then
MsgBox "请关闭其余的工作簿！"
Exit Sub
End If
'------------------------选择要合并的工作簿所在文件夹，获取路径---------
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then

MsgBox "没有选择任何文件夹！"
Exit Sub

Else

pt = .SelectedItems(1)

End If
End With
'-------------------------遍历文件夹中的所有Excel文件，并进行处理--------
fn = Dir(pt & "*.xlsx") '若你的文档是2007或更新版本，则将.xls改成.xlsx
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
K = K + 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Open(pt & "\" & fn, , True)
Set sh = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wb.Worksheets(1).Rows.Copy sh.Rows
sh.Name = Left(fn, Len(fn) - IIf(Right(fn, 1) = "x", 5, 4))
wb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
fn = Dir
Loop
Sheets("FC通期").Select
'Application.ScreenUpdating = True
MsgBox "处理结束。共处理" & K & "个文件，耗时" & Timer - t & "秒"

End Sub

Sub 列出sheet名单()
Application.ScreenUpdating = False

Sheets("表单").Columns("A:B").ClearContents

For Each sh In Sheets
K = K + 1
Sheets("表单").Cells(K, 1) = sh.Name
Next

Call 文件处理2
Call 检查日期
Call 大金额成品统计
Call 重复料号
Application.ScreenUpdating = True
MsgBox ("sheet名单整理完毕，共 " & K - 8 & " 个文件。")

End Sub
Sub DeleteSheet()
Application.DisplayAlerts = False
On Error GoTo 999

Dim j, h
For j = 9 To 999
If Not Sheets("表单").Cells(j, 1).Value = 0 Then
h = Sheets("表单").Cells(j, 1).Value
Sheets(h).Delete
End If

Next
Sheets("备用1").Rows("2:29999").ClearContents

Application.DisplayAlerts = True
999: End Sub

Sub 删除加工费()
Dim i1, i2, i3, arr
arr = Array(9, 10, 11, 12, 17, 18, 19, 20, 25, 26, 27, 28, 33, 34, 35, 36, 41, 42, 43, 44, 49, 50, 51, 52)

Sheet1.Select
i2 = Range("D4")
For Each i1 In arr
Range(Cells(7, i1), Cells(i2, i1)).ClearContents
Next i1

End Sub
Sub 删除销售额()
Dim i1, i2, i3, arr
arr = Array(9, 10, 11, 12, 17, 18, 19, 20, 25, 26, 27, 28, 33, 34, 35, 36, 41, 42, 43, 44, 49, 50, 51, 52)

Sheet4.Select
i2 = Range("D4")
For Each i1 In arr
Range(Cells(7, i1), Cells(i2, i1)).ClearContents
Next i1

End Sub
Sub 删除综合毛利()

End Sub

Sub 加工费填写()
Dim lin, n, nwbs, x1, x2, x3, i1, i2, i3, i4, i5, i6, j1, j2, j3, j4, j5, j6, j11, j22, j33, j44, j55, j66, j111, j222, j333, j444, j555, j666
Dim q1, q2, q3, q4, q5, q6, a1, a2, a3, a4, a5, a6, q11, q22, q33, q44, q55, q66, a11, a22, a33, a44, a55, a66
Call 全局变量
Call 删除加工费
Application.ScreenUpdating = False

Sheet1.Select
lin = Sheet1.Range("D4")

For n = 7 To lin

nwbs = Sheet1.Cells(n, 4).Value

x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""
x1 = Sheets("表单").Cells(x2, 1).Value

Sheets(x1).Select

Range("A1").Select

Set Rng = Sheets(x1).UsedRange.Find(nwbs)
If Rng Is Nothing Then GoTo line1

Range("A1").Select

Cells.Find(what:=mth1, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j1 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j11 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth2, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j2 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j22 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth3, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j3 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j33 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth4, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j4 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j44 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth5, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j5 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j55 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth6, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j6 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
j66 = Selection.Column

i3 = WorksheetFunction.CountA(Sheets(x1).Columns(j11))
'计算数据表共多少列

Sheets(x1).Range("A1").Select

Cells.Find(what:="PO WBS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    'Cells.FindNext(After:=ActiveCell).Activate

i5 = Selection.Row
'计算旧数据起始行数

i1 = n
Do While Sheet1.Cells(i1, 4) <> ""
i2 = "WBS" & Sheet1.Cells(i1, 4).Value


   Sheets(x1).Select

q1 = 0
q2 = 0
q3 = 0
q4 = 0
q5 = 0
q6 = 0
a1 = 0
a2 = 0
a3 = 0
a4 = 0
a5 = 0
a6 = 0

   
    i4 = 1
  Do While Sheets(x1).Cells(i4, 1) <> ""
  i22 = "WBS" & Sheets(x1).Cells(i4, 1).Value
   If i22 = i2 Then
   q1 = q1 + Sheets(x1).Cells(i4, j1).Value
   a1 = a1 + Sheets(x1).Cells(i4, j11).Value
   q2 = q2 + Sheets(x1).Cells(i4, j2).Value
   a2 = a2 + Sheets(x1).Cells(i4, j22).Value
   q3 = q3 + Sheets(x1).Cells(i4, j3).Value
   a3 = a3 + Sheets(x1).Cells(i4, j33).Value
   q4 = q4 + Sheets(x1).Cells(i4, j4).Value
   a4 = a4 + Sheets(x1).Cells(i4, j44).Value
   q5 = q5 + Sheets(x1).Cells(i4, j5).Value
   a5 = a5 + Sheets(x1).Cells(i4, j55).Value
   q6 = q6 + Sheets(x1).Cells(i4, j6).Value
   a6 = a6 + Sheets(x1).Cells(i4, j66).Value
   
   
   
End If

If q1 <> 0 Then
Sheet1.Cells(i1, 9) = q1
End If
If a1 <> 0 Then
Sheet1.Cells(i1, 10) = a1
End If
If q2 <> 0 Then
Sheet1.Cells(i1, 17) = q2
End If
If a2 <> 0 Then
Sheet1.Cells(i1, 18) = a2
End If
If q3 <> 0 Then
Sheet1.Cells(i1, 25) = q3
End If
If a3 <> 0 Then
Sheet1.Cells(i1, 26) = a3
End If
If q4 <> 0 Then
Sheet1.Cells(i1, 33) = q4
End If
If a4 <> 0 Then
Sheet1.Cells(i1, 34) = a4
End If
If q5 <> 0 Then
Sheet1.Cells(i1, 41) = q5
End If
If a5 <> 0 Then
Sheet1.Cells(i1, 42) = a5
End If
If q6 <> 0 Then
Sheet1.Cells(i1, 49) = q6
End If
If a6 <> 0 Then
Sheet1.Cells(i1, 50) = a6
End If
i4 = i4 + 1
Loop

q1 = 0
q2 = 0
q3 = 0
q4 = 0
q5 = 0
q6 = 0
a1 = 0
a2 = 0
a3 = 0
a4 = 0
a5 = 0
a6 = 0


   i4 = i5
   Do While Sheets(x1).Cells(i4, 1) <> ""
  i22 = "WBS" & Sheets(x1).Cells(i4, 1).Value
   If i22 = i2 Then
   q1 = q1 + Sheets(x1).Cells(i4, j1).Value
   a1 = a1 + Sheets(x1).Cells(i4, j11).Value
   q2 = q2 + Sheets(x1).Cells(i4, j2).Value
   a2 = a2 + Sheets(x1).Cells(i4, j22).Value
   q3 = q3 + Sheets(x1).Cells(i4, j3).Value
   a3 = a3 + Sheets(x1).Cells(i4, j33).Value
   q4 = q4 + Sheets(x1).Cells(i4, j4).Value
   a4 = a4 + Sheets(x1).Cells(i4, j44).Value
   q5 = q5 + Sheets(x1).Cells(i4, j5).Value
   a5 = a5 + Sheets(x1).Cells(i4, j55).Value
   q6 = q6 + Sheets(x1).Cells(i4, j6).Value
   a6 = a6 + Sheets(x1).Cells(i4, j66).Value
   
End If


 If q1 <> 0 Then
Sheet1.Cells(i1, 11) = q1
End If
If a1 <> 0 Then
Sheet1.Cells(i1, 12) = a1
End If
If q2 <> 0 Then
Sheet1.Cells(i1, 19) = q2
End If
If a2 <> 0 Then
Sheet1.Cells(i1, 20) = a2
End If
If q3 <> 0 Then
Sheet1.Cells(i1, 27) = q3
End If
If a3 <> 0 Then
Sheet1.Cells(i1, 28) = a3
End If
If q4 <> 0 Then
Sheet1.Cells(i1, 35) = q4
End If
If a4 <> 0 Then
Sheet1.Cells(i1, 36) = a4
End If
If q5 <> 0 Then
Sheet1.Cells(i1, 43) = q5
End If
If a5 <> 0 Then
Sheet1.Cells(i1, 44) = a5
End If
If q6 <> 0 Then
Sheet1.Cells(i1, 51) = q6
End If
If a6 <> 0 Then
Sheet1.Cells(i1, 52) = a6
End If


i4 = i4 + 1
Loop





i1 = i1 + 1
Loop

line1:

x2 = x2 + 1
Loop

Next n

Call 合并项目输入
'Call 合计输入
Sheet1.Select
Application.ScreenUpdating = True
MsgBox ("加工费数据已整合完毕。请检查数据。")

End Sub
Sub 销售额填写()
Dim lin, n, nwbs, x1, x2, x3, i1, i2, i3, i4, i5, i6, j1, j2, j3, j4, j5, j6, j11, j22, j33, j44, j55, j66, j111, j222, j333, j444, j555, j666
Dim q1, q2, q3, q4, q5, q6, a1, a2, a3, a4, a5, a6, q11, q22, q33, q44, q55, q66, a11, a22, a33, a44, a55, a66
Call 全局变量
Call 删除销售额
Application.ScreenUpdating = False
Sheet4.Select
lin = Sheet1.Range("D4")

For n = 7 To lin

nwbs = Sheet1.Cells(n, 4).Value
x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""
x1 = Sheets("表单").Cells(x2, 1).Value

Sheets(x1).Select

Set Rng = Sheets(x1).UsedRange.Find(nwbs)
If Rng Is Nothing Then GoTo line1

Range("A1").Select

Cells.Find(what:=mth1, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j1 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j11 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth2, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j2 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j22 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth3, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j3 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j33 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth4, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j4 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j44 = Selection.Column
Sheets(x1).Range("A1").Select

Cells.Find(what:=mth5, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j5 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j55 = Selection.Column

Sheets(x1).Range("A1").Select

Cells.Find(what:=mth6, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j6 = Selection.Column
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
j66 = Selection.Column

i3 = WorksheetFunction.CountA(Sheets(x1).Columns(j11))
'计算数据表共多少列

Sheets(x1).Range("A1").Select

Cells.Find(what:="PO WBS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    'Cells.FindNext(After:=ActiveCell).Activate

i5 = Selection.Row
'计算旧数据起始行数

i1 = n
Do While Sheet1.Cells(i1, 4) <> ""
i2 = "WBS" & Sheet1.Cells(i1, 4).Value


   Sheets(x1).Select

q1 = 0
q2 = 0
q3 = 0
q4 = 0
q5 = 0
q6 = 0
a1 = 0
a2 = 0
a3 = 0
a4 = 0
a5 = 0
a6 = 0

   
    i4 = 1
  Do While Sheets(x1).Cells(i4, 1) <> ""
  
   i22 = "WBS" & Sheets(x1).Cells(i4, 1).Value
   
   If i22 = i2 Then
   q1 = q1 + Sheets(x1).Cells(i4, j1).Value
   a1 = a1 + Sheets(x1).Cells(i4, j11).Value
   q2 = q2 + Sheets(x1).Cells(i4, j2).Value
   a2 = a2 + Sheets(x1).Cells(i4, j22).Value
   q3 = q3 + Sheets(x1).Cells(i4, j3).Value
   a3 = a3 + Sheets(x1).Cells(i4, j33).Value
   q4 = q4 + Sheets(x1).Cells(i4, j4).Value
   a4 = a4 + Sheets(x1).Cells(i4, j44).Value
   q5 = q5 + Sheets(x1).Cells(i4, j5).Value
   a5 = a5 + Sheets(x1).Cells(i4, j55).Value
   q6 = q6 + Sheets(x1).Cells(i4, j6).Value
   a6 = a6 + Sheets(x1).Cells(i4, j66).Value
   
End If

If q1 <> 0 Then
Sheet4.Cells(i1, 9) = q1
End If
If a1 <> 0 Then
Sheet4.Cells(i1, 10) = a1
End If
If q2 <> 0 Then
Sheet4.Cells(i1, 17) = q2
End If
If a2 <> 0 Then
Sheet4.Cells(i1, 18) = a2
End If
If q3 <> 0 Then
Sheet4.Cells(i1, 25) = q3
End If
If a3 <> 0 Then
Sheet4.Cells(i1, 26) = a3
End If
If q4 <> 0 Then
Sheet4.Cells(i1, 33) = q4
End If
If a4 <> 0 Then
Sheet4.Cells(i1, 34) = a4
End If
If q5 <> 0 Then
Sheet4.Cells(i1, 41) = q5
End If
If a5 <> 0 Then
Sheet4.Cells(i1, 42) = a5
End If
If q6 <> 0 Then
Sheet4.Cells(i1, 49) = q6
End If
If a6 <> 0 Then
Sheet4.Cells(i1, 50) = a6
End If



i4 = i4 + 1
Loop

q1 = 0
q2 = 0
q3 = 0
q4 = 0
q5 = 0
q6 = 0
a1 = 0
a2 = 0
a3 = 0
a4 = 0
a5 = 0
a6 = 0

   i4 = i5
   Do While Sheets(x1).Cells(i4, 1) <> ""
   
   i22 = "WBS" & Sheets(x1).Cells(i4, 1).Value
   
   If i22 = i2 Then
   q1 = q1 + Sheets(x1).Cells(i4, j1).Value
   a1 = a1 + Sheets(x1).Cells(i4, j11).Value
   q2 = q2 + Sheets(x1).Cells(i4, j2).Value
   a2 = a2 + Sheets(x1).Cells(i4, j22).Value
   q3 = q3 + Sheets(x1).Cells(i4, j3).Value
   a3 = a3 + Sheets(x1).Cells(i4, j33).Value
   q4 = q4 + Sheets(x1).Cells(i4, j4).Value
   a4 = a4 + Sheets(x1).Cells(i4, j44).Value
   q5 = q5 + Sheets(x1).Cells(i4, j5).Value
   a5 = a5 + Sheets(x1).Cells(i4, j55).Value
   q6 = q6 + Sheets(x1).Cells(i4, j6).Value
   a6 = a6 + Sheets(x1).Cells(i4, j66).Value
   
End If


 If q1 <> 0 Then
Sheet4.Cells(i1, 11) = q1
End If
If a1 <> 0 Then
Sheet4.Cells(i1, 12) = a1
End If
If q2 <> 0 Then
Sheet4.Cells(i1, 19) = q2
End If
If a2 <> 0 Then
Sheet4.Cells(i1, 20) = a2
End If
If q3 <> 0 Then
Sheet4.Cells(i1, 27) = q3
End If
If a3 <> 0 Then
Sheet4.Cells(i1, 28) = a3
End If
If q4 <> 0 Then
Sheet4.Cells(i1, 35) = q4
End If
If a4 <> 0 Then
Sheet4.Cells(i1, 36) = a4
End If
If q5 <> 0 Then
Sheet4.Cells(i1, 43) = q5
End If
If a5 <> 0 Then
Sheet4.Cells(i1, 44) = a5
End If
If q6 <> 0 Then
Sheet4.Cells(i1, 51) = q6
End If
If a6 <> 0 Then
Sheet4.Cells(i1, 52) = a6
End If


i4 = i4 + 1
Loop





i1 = i1 + 1
Loop

line1:
x2 = x2 + 1
Loop

Next n

Call 合并项目输入
'Call 合计输入
Sheet4.Select
Application.ScreenUpdating = True
MsgBox ("加工费数据已整合完毕。请检查数据。")

End Sub
Sub 综合毛利填写()

End Sub
Sub 检查日期()
Dim i1, i2, i3, i4, j1

i4 = Sheet1.Cells(2, 3)

Sheets("表单").Select

i1 = 9
Do While Cells(i1, 1) <> ""
i2 = Cells(i1, 1)
Sheets("表单").Cells(i1, 2) = Mid(Sheets(i2).Cells(1, 25).Value, 5, 6)
i1 = i1 + 1
Loop

j1 = ""
i1 = 9
Do While Cells(i1, 1) <> ""
i3 = Cells(i1, 1)
If Cells(i1, 2) <> i4 Then j1 = j1 & " " & i3

i1 = i1 + 1
Loop
Sheet1.Select

If j1 <> "" Then
MsgBox ("如下表格日期不对" & Chr(13) & j1)
Sheets("表单").Select
End If

End Sub

Sub 合并项目输入()
Dim i1, i2, i3, i4
Dim lastline
Dim arr3
arr3 = Array("FC通期", "SX销售预测")

For Each i4 In arr3

Sheets(i4).Select

lastline = 6

i1 = 7
Do While Cells(i1, 1) <> ""
If Cells(i1, 4) = "submit" Then

i2 = 7
Do While Cells(6, i2) <> ""
x1 = i1 - lastline - 1

Cells(i1, i2).Formula = "=SUM(R[-" & x1 & "]C:R[-1]C)"
i2 = i2 + 1
Loop
lastline = i1

End If

i1 = i1 + 1
Loop

Next i4

End Sub

Sub 合计输入()

Dim i1
Dim arr
arr = Array("FC通期", "SX销售预测")

For Each i1 In arr
Sheet1.Select
Range("G80:AJ80").Select
Selection.FormulaR1C1 = _
    "=R[-65]C+R[-62]C+R[-57]C+R[-50]C+R[-45]C+R[-42]C+R[-39]C+R[-36]C+R[-33]C+R[-29]C+SUM(R[-28]C:R[-1]C)"
    
Sheet4.Select
Range("G80:AJ80").Select
Selection.FormulaR1C1 = _
    "=R[-65]C+R[-62]C+R[-57]C+R[-50]C+R[-45]C+R[-42]C+R[-39]C+R[-36]C+R[-33]C+R[-29]C+SUM(R[-28]C:R[-1]C)"
Next i1

End Sub

Sub 文件处理2()
Dim x1, x2, x3, i1, i2, i3, i4, j1, j2, j3, j4, j5, j6
Call 全局变量

x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""

x1 = Sheets("表单").Cells(x2, 1).Value

Sheets(x1).Select
i1 = Application.WorksheetFunction.CountA(Sheets(x1).Range("A1:ZZ1"))

For i2 = i1 To 25 Step -1
i3 = Len(Cells(1, i2))
If i3 <> 10 Then
Columns(i2).Delete Shift:=xlToLeft

End If
Next
'以上代码用于删除表单内的非月份的数据，原理是月份的单元格正好是 10个字符

i2 = WorksheetFunction.CountA(Rows("1"))
'确定多少列开始是空的

Sheets(x1).Range("A1").Select

Cells.Find(what:="PO WBS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
'Cells.FindNext(After:=ActiveCell).Activate

i3 = Selection.Row
'确定原始FC起始列

Cells(1, i2 + 1) = mth1 & "加工费"
Cells(1, i2 + 2) = mth2 & "加工费"
Cells(1, i2 + 3) = mth3 & "加工费"
Cells(1, i2 + 4) = mth4 & "加工费"
Cells(1, i2 + 5) = mth5 & "加工费"
Cells(1, i2 + 6) = mth6 & "加工费"

Cells(1, i2 + 7) = mth1 & "销售额"
Cells(1, i2 + 8) = mth2 & "销售额"
Cells(1, i2 + 9) = mth3 & "销售额"
Cells(1, i2 + 10) = mth4 & "销售额"
Cells(1, i2 + 11) = mth5 & "销售额"
Cells(1, i2 + 12) = mth6 & "销售额"

Cells(1, i2 + 13) = mth1 & "FG毛利"
Cells(1, i2 + 14) = mth2 & "FG毛利"
Cells(1, i2 + 15) = mth3 & "FG毛利"
Cells(1, i2 + 16) = mth4 & "FG毛利"
Cells(1, i2 + 17) = mth5 & "FG毛利"
Cells(1, i2 + 18) = mth6 & "FG毛利"

Cells(1, i2 + 19) = mth1 & "RM销售额"
Cells(1, i2 + 20) = mth2 & "RM销售额"
Cells(1, i2 + 21) = mth3 & "RM销售额"
Cells(1, i2 + 22) = mth4 & "RM销售额"
Cells(1, i2 + 23) = mth5 & "RM销售额"
Cells(1, i2 + 24) = mth6 & "RM销售额"

Cells(1, i2 + 25) = mth1 & "RM毛利"
Cells(1, i2 + 26) = mth2 & "RM毛利"
Cells(1, i2 + 27) = mth3 & "RM毛利"
Cells(1, i2 + 28) = mth4 & "RM毛利"
Cells(1, i2 + 29) = mth5 & "RM毛利"
Cells(1, i2 + 30) = mth6 & "RM毛利"

Cells(1, i2 + 31) = mth1 & "合计销售额"
Cells(1, i2 + 32) = mth2 & "合计销售额"
Cells(1, i2 + 33) = mth3 & "合计销售额"
Cells(1, i2 + 34) = mth4 & "合计销售额"
Cells(1, i2 + 35) = mth5 & "合计销售额"
Cells(1, i2 + 36) = mth6 & "合计销售额"

Cells(1, i2 + 37) = mth1 & "合计毛利"
Cells(1, i2 + 38) = mth2 & "合计毛利"
Cells(1, i2 + 39) = mth3 & "合计毛利"
Cells(1, i2 + 40) = mth4 & "合计毛利"
Cells(1, i2 + 41) = mth5 & "合计毛利"
Cells(1, i2 + 42) = mth6 & "合计毛利"

Sheets(x1).Range("A1").Select

Cells.Find(what:=mth1, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j1 = Selection.Column

Cells.Find(what:=mth2, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j2 = Selection.Column

Cells.Find(what:=mth3, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j3 = Selection.Column

Cells.Find(what:=mth4, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j4 = Selection.Column

Cells.Find(what:=mth5, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j5 = Selection.Column

Cells.Find(what:=mth6, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

j6 = Selection.Column

'定义每月合计数量的列数

For i4 = 2 To (i3 - 1)
Cells(i4, i2 + 1) = Cells(i4, 16) * Cells(i4, j1)
Cells(i4, i2 + 2) = Cells(i4, 16) * Cells(i4, j2)
Cells(i4, i2 + 3) = Cells(i4, 16) * Cells(i4, j3)
Cells(i4, i2 + 4) = Cells(i4, 16) * Cells(i4, j4)
Cells(i4, i2 + 5) = Cells(i4, 16) * Cells(i4, j5)
Cells(i4, i2 + 6) = Cells(i4, 16) * Cells(i4, j6)

Cells(i4, i2 + 7) = Cells(i4, 15) * Cells(i4, j1)
Cells(i4, i2 + 8) = Cells(i4, 15) * Cells(i4, j2)
Cells(i4, i2 + 9) = Cells(i4, 15) * Cells(i4, j3)
Cells(i4, i2 + 10) = Cells(i4, 15) * Cells(i4, j4)
Cells(i4, i2 + 11) = Cells(i4, 15) * Cells(i4, j5)
Cells(i4, i2 + 12) = Cells(i4, 15) * Cells(i4, j6)

Cells(i4, i2 + 13) = Cells(i4, 20) * Cells(i4, j1)
Cells(i4, i2 + 14) = Cells(i4, 20) * Cells(i4, j2)
Cells(i4, i2 + 15) = Cells(i4, 20) * Cells(i4, j3)
Cells(i4, i2 + 16) = Cells(i4, 20) * Cells(i4, j4)
Cells(i4, i2 + 17) = Cells(i4, 20) * Cells(i4, j5)
Cells(i4, i2 + 18) = Cells(i4, 20) * Cells(i4, j6)

Cells(i4, i2 + 19) = Cells(i4, 12) * Cells(i4, j1)
Cells(i4, i2 + 20) = Cells(i4, 12) * Cells(i4, j2)
Cells(i4, i2 + 21) = Cells(i4, 12) * Cells(i4, j3)
Cells(i4, i2 + 22) = Cells(i4, 12) * Cells(i4, j4)
Cells(i4, i2 + 23) = Cells(i4, 12) * Cells(i4, j5)
Cells(i4, i2 + 24) = Cells(i4, 12) * Cells(i4, j6)

Cells(i4, i2 + 25) = Cells(i4, 18) * Cells(i4, j1)
Cells(i4, i2 + 26) = Cells(i4, 18) * Cells(i4, j2)
Cells(i4, i2 + 27) = Cells(i4, 18) * Cells(i4, j3)
Cells(i4, i2 + 28) = Cells(i4, 18) * Cells(i4, j4)
Cells(i4, i2 + 29) = Cells(i4, 18) * Cells(i4, j5)
Cells(i4, i2 + 30) = Cells(i4, 18) * Cells(i4, j6)

Cells(i4, i2 + 31) = Cells(i4, i2 + 7) + Cells(i4, i2 + 19)
Cells(i4, i2 + 32) = Cells(i4, i2 + 8) + Cells(i4, i2 + 20)
Cells(i4, i2 + 33) = Cells(i4, i2 + 9) + Cells(i4, i2 + 21)
Cells(i4, i2 + 34) = Cells(i4, i2 + 10) + Cells(i4, i2 + 22)
Cells(i4, i2 + 35) = Cells(i4, i2 + 11) + Cells(i4, i2 + 23)
Cells(i4, i2 + 36) = Cells(i4, i2 + 12) + Cells(i4, i2 + 24)

Cells(i4, i2 + 37) = Cells(i4, i2 + 13) + Cells(i4, i2 + 25)
Cells(i4, i2 + 38) = Cells(i4, i2 + 14) + Cells(i4, i2 + 26)
Cells(i4, i2 + 39) = Cells(i4, i2 + 15) + Cells(i4, i2 + 27)
Cells(i4, i2 + 40) = Cells(i4, i2 + 16) + Cells(i4, i2 + 28)
Cells(i4, i2 + 41) = Cells(i4, i2 + 17) + Cells(i4, i2 + 29)
Cells(i4, i2 + 42) = Cells(i4, i2 + 18) + Cells(i4, i2 + 30)

Next i4

Cells(i3, i2 + 1) = mth1 & "加工费"
Cells(i3, i2 + 2) = mth2 & "加工费"
Cells(i3, i2 + 3) = mth3 & "加工费"
Cells(i3, i2 + 4) = mth4 & "加工费"
Cells(i3, i2 + 5) = mth5 & "加工费"
Cells(i3, i2 + 6) = mth6 & "加工费"

Cells(i3, i2 + 7) = mth1 & "销售额"
Cells(i3, i2 + 8) = mth2 & "销售额"
Cells(i3, i2 + 9) = mth3 & "销售额"
Cells(i3, i2 + 10) = mth4 & "销售额"
Cells(i3, i2 + 11) = mth5 & "销售额"
Cells(i3, i2 + 12) = mth6 & "销售额"

Cells(i3, i2 + 13) = mth1 & "FG毛利"
Cells(i3, i2 + 14) = mth2 & "FG毛利"
Cells(i3, i2 + 15) = mth3 & "FG毛利"
Cells(i3, i2 + 16) = mth4 & "FG毛利"
Cells(i3, i2 + 17) = mth5 & "FG毛利"
Cells(i3, i2 + 18) = mth6 & "FG毛利"

Cells(i3, i2 + 19) = mth1 & "RM销售额"
Cells(i3, i2 + 20) = mth2 & "RM销售额"
Cells(i3, i2 + 21) = mth3 & "RM销售额"
Cells(i3, i2 + 22) = mth4 & "RM销售额"
Cells(i3, i2 + 23) = mth5 & "RM销售额"
Cells(i3, i2 + 24) = mth6 & "RM销售额"

Cells(i3, i2 + 25) = mth1 & "RM毛利"
Cells(i3, i2 + 26) = mth2 & "RM毛利"
Cells(i3, i2 + 27) = mth3 & "RM毛利"
Cells(i3, i2 + 28) = mth4 & "RM毛利"
Cells(i3, i2 + 29) = mth5 & "RM毛利"
Cells(i3, i2 + 30) = mth6 & "RM毛利"

Cells(i3, i2 + 31) = mth1 & "合计销售额"
Cells(i3, i2 + 32) = mth2 & "合计销售额"
Cells(i3, i2 + 33) = mth3 & "合计销售额"
Cells(i3, i2 + 34) = mth4 & "合计销售额"
Cells(i3, i2 + 35) = mth5 & "合计销售额"
Cells(i3, i2 + 36) = mth6 & "合计销售额"

Cells(i3, i2 + 37) = mth1 & "合计毛利"
Cells(i3, i2 + 38) = mth2 & "合计毛利"
Cells(i3, i2 + 39) = mth3 & "合计毛利"
Cells(i3, i2 + 40) = mth4 & "合计毛利"
Cells(i3, i2 + 41) = mth5 & "合计毛利"
Cells(i3, i2 + 42) = mth6 & "合计毛利"

For i4 = (i3 + 1) To (i3 + 1) * 2
Cells(i4, i2 + 1) = Cells(i4, 16) * Cells(i4, j1)
Cells(i4, i2 + 2) = Cells(i4, 16) * Cells(i4, j2)
Cells(i4, i2 + 3) = Cells(i4, 16) * Cells(i4, j3)
Cells(i4, i2 + 4) = Cells(i4, 16) * Cells(i4, j4)
Cells(i4, i2 + 5) = Cells(i4, 16) * Cells(i4, j5)
Cells(i4, i2 + 6) = Cells(i4, 16) * Cells(i4, j6)

Next i4

x2 = x2 + 1
Loop

Sheet1.Select

End Sub

Sub 大金额成品统计()
Dim x1, x2, x3, i1, i2, i3, i4, j1, j2, j3, j4, j5, j6
'Call 全局变量

Sheets("表单").Range("E3:L9999").ClearContents

x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""

x1 = Sheets("表单").Cells(x2, 1).Value

Sheets(x1).Select
If Left(Sheets(x1).Cells(2, 2), 4) = "JUKI" Then GoTo line1

i1 = Application.WorksheetFunction.RoundDown(Application.WorksheetFunction.CountA(Sheets(x1).Range("A:A")) / 2, 0)
'计算明细表内有效数据一共多少行

For x3 = 2 To i1

i2 = WorksheetFunction.CountA(Sheets("表单").Columns("E")) + 1
'确定表单F列多少列开始是空的

If Sheets(x1).Cells(x3, 16) >= Sheets("表单").Cells(1, 12) Or Sheets(x1).Cells(x3, 16) <= 0 Then
Sheets("表单").Cells(i2, 5) = Sheets(x1).Cells(x3, 1)
Sheets("表单").Cells(i2, 6) = Sheets(x1).Cells(x3, 2)
Sheets("表单").Cells(i2, 7) = Sheets(x1).Cells(x3, 4)
Sheets("表单").Cells(i2, 8) = Sheets(x1).Cells(x3, 5)
Sheets("表单").Cells(i2, 9) = Sheets(x1).Cells(x3, 6)
Sheets("表单").Cells(i2, 10) = Sheets(x1).Cells(x3, 7)
Sheets("表单").Cells(i2, 11) = Sheets(x1).Cells(x3, 8)
Sheets("表单").Cells(i2, 12) = Sheets(x1).Cells(x3, 16)
End If

line1:

Next x3

x2 = x2 + 1
Loop
Sheets("表单").Select

End Sub

Sub 重复料号()
Dim x1, x2, x3, i1, i2, i3, i4, j1, j2, j3, j4, j5, j6
'Call 全局变量

Sheets("表单").Range("Q3:U9999").ClearContents

x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""

x1 = Sheets("表单").Cells(x2, 1).Value

Sheets(x1).Select
'If Sheets(x1).Cells(2, 2) = "JUKI_SX/SJC_EMS/SJC_Ind_Sewing" Then GoTo line1

i1 = Application.WorksheetFunction.RoundDown(Application.WorksheetFunction.CountA(Sheets(x1).Range("A:A")) / 2, 0)
'计算明细表内有效数据一共多少行

For x3 = 2 To i1

i2 = WorksheetFunction.CountA(Sheets("表单").Columns("Q")) + 1
'确定表单F列多少列开始是空的
j1 = Sheets(x1).Cells(x3, 4)
j2 = Application.WorksheetFunction.CountIf(Sheets(x1).Range(Cells(x3, 4), Cells(i1, 4)), j1)
'j2 = Sheets(x1).Ranges("A1:A1")

If j2 >= 2 Then
Sheets("表单").Cells(i2, 17) = Sheets(x1).Cells(x3, 1)
Sheets("表单").Cells(i2, 18) = Sheets(x1).Cells(x3, 2)
Sheets("表单").Cells(i2, 19) = Sheets(x1).Cells(x3, 4)
Sheets("表单").Cells(i2, 20) = Sheets(x1).Cells(x3, 5)
Sheets("表单").Cells(i2, 21) = Sheets(x1).Cells(x3, 16)
End If

line1:

Next x3

x2 = x2 + 1
Loop
Sheets("表单").Select

End Sub

Sub 合并全项目加工费预测()
Dim lineno, sht
Dim i1, i2, i3, i4, i5, x1, x2
Dim arr()

Application.ScreenUpdating = False
Sheets("备用1").Rows("2:29999").ClearContents

x2 = 9
Do While Sheets("表单").Cells(x2, 1) <> ""

i1 = Sheets("表单").Cells(x2, 1).Value

Sheets(i1).Select
'If Sheets(x1).Cells(2, 2) = "JUKI_SX/SJC_EMS/SJC_Ind_Sewing" Then GoTo line1

i2 = 0
y1 = 1
Do While Sheets(i1).Cells(y1, 1) <> ""
i2 = i2 + 1

y1 = y1 + 1
Loop

'i2 = Application.WorksheetFunction.RoundUp(Application.WorksheetFunction.CountA(Sheets(i1).Range("A:A")) / 2, 0)
'计算明细表内有效数据一共多少行

For i3 = 2 To i2
'arr() = Sheets(i1).Range(Cells(i3, 1), Cells(i3, 42))

i4 = Application.WorksheetFunction.CountA(Sheets("备用1").Range("A:A")) + 1

Sheets("备用1").Rows(i4) = Sheets(i1).Rows(i3).Value

Next i3

x2 = x2 + 1
Loop

Application.ScreenUpdating = True

Sheets("备用1").Select
MsgBox ("全项目数据合并完成。请检查数据。")

End Sub

加工费合并报表

最新文章

最近回复

分类

归档

其它