|
|
工作中發(fā)現(xiàn)每次排翻縫計(jì)劃時(shí)，總要把excel總表的訂單信息按每個(gè)訂單預(yù)定計(jì)劃領(lǐng)坯日期，復(fù)制到翻縫計(jì)劃表對(duì)應(yīng)的日期下。今天就琢磨著能否一鍵搞定，實(shí)現(xiàn)自動(dòng)翻縫排單，沒(méi)有想到41行代碼就能搞定每天要花20分鐘的工作量，把過(guò)程記錄下：
源表一（總表）
目標(biāo)表二（翻縫計(jì)劃）
實(shí)現(xiàn)思路：
先獲取總表中選取行的所有行號(hào)并存入數(shù)組中，然后把所在行對(duì)應(yīng)的計(jì)劃領(lǐng)坯日期去翻縫計(jì)劃中去查找，找到后獲得翻縫計(jì)劃表里
的日期所在的行號(hào)，并向下移動(dòng)3行插入一空白行，再把總表中相應(yīng)的訂單信息數(shù)據(jù)對(duì)應(yīng)填下到翻縫計(jì)劃表的空白行中，同時(shí)把對(duì)應(yīng)合約號(hào)以紅色底紋標(biāo)識(shí)。
自動(dòng)排單按鈕后的vba代碼：
Public Sub getrows_to_fanbu()
Dim a() As Integer
k = Selection.Cells.Count
ReDim a(k)
a(0) = -1
n = 0
For Each c In Selection.Cells
n = n + 1
a(n) = c.Row
For i = 0 To n - 1
If a(n) = a(i) Then
n = n - 1
End If
Next i
Next c
Application.StatusBar = "系統(tǒng)正在自動(dòng)排單中，請(qǐng)耐心等待1分鐘左右...."
Dim currow As Double
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.MaxChange = 0.001
For i = 1 To n
currow = Application.WorksheetFunction.Match(Sheets("總表").Cells(a(i), 16), Sheets("翻縫計(jì)劃").Range("k:k"), 1)
Sheets("翻縫計(jì)劃").Rows(currow + 3).Resize(1).Insert '翻縫日期下第二行處插入一空白行
'翻縫計(jì)劃表里寫(xiě)入數(shù)據(jù)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 1) = Sheets("總表").Cells(a(i), 2)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 2) = Sheets("總表").Cells(a(i), 3)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 3) = Sheets("總表").Cells(a(i), 4)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 4) = Sheets("總表").Cells(a(i), 5)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 5) = Sheets("總表").Cells(a(i), 6)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 6) = Sheets("總表").Cells(a(i), 7)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 7) = Sheets("總表").Cells(a(i), 8)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 8) = Sheets("總表").Cells(a(i), 9)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 9) = Sheets("總表").Cells(a(i), 10)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 10) = Sheets("總表").Cells(a(i), 11)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 11) = Sheets("總表").Cells(a(i), 12)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 12) = Sheets("總表").Cells(a(i), 13)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 13) = Sheets("總表").Cells(a(i), 14)
'格式化填寫(xiě)的數(shù)據(jù)
Sheets("翻縫計(jì)劃").Cells(currow + 3, 2).Interior.Color = RGB(255, 0, 0) '設(shè)置合約號(hào)單元格的背景色為紅色
'Sheets("翻縫計(jì)劃").Activate
'' Sheets("翻縫計(jì)劃").Range(Cells(currow + 3, 1), Cells(currow + 3, 14)).Select
'With Selection
' .Font.Name = "宋體"
' .Font.Size = 10
' .Font.FontStyle = "常規(guī)"
' End With
'MsgBox currow
Next i
Application.Calculation = xlCalculationAutomatic
Application.MaxChange = 0.001
Application.ScreenUpdating = True
Application.StatusBar = "自動(dòng)排單成功"
' Dim oe As New Excel.Application
' Dim ow As Workbook
' Dim os As Worksheet
' Set ow = oe.Workbooks.Open("E:\其他\外發(fā)加工單.xls")
' Set os = ow.Worksheets("加工單")
' oe.Visible = False
'For i = 1 To n
'a(i) 為選定單元格所在的行數(shù)
' ' os.Cells(2, 4) = ""
' os.Cells(3, 2) = ""
' os.Cells(4, 2) = ""
' os.Cells(4, 6) = "0 米"
' os.Cells(5, 2) = ""
' os.Cells(2, 4) = Trim(Cells(a(i), 2))
' os.Cells(3, 2) = Trim(Cells(a(i), 3)) & " " & Trim(Cells(a(i), 4)) & " " & Trim(Cells(a(i), 5))
' os.Cells(4, 2) = Trim(Cells(a(i), 6))
' os.Cells(4, 6) = Cells(a(i), 7) & " 米"
' os.Cells(5, 2) = Trim(Cells(a(i), 12))
' os.PrintOut
'Next i
' ow.Save
' ow.Close
' Set ow = Nothing
' oe.Quit
'
End Sub
使用方法：
1、選定總表中需要排單的所在行（可以同時(shí)選多行）
2、點(diǎn)擊自動(dòng)排單按鈕
編程中遇到的問(wèn)題：
因?yàn)閿?shù)據(jù)量很大，插入空白行-復(fù)制--黏貼，excel每次都要自動(dòng)計(jì)算很耗時(shí)，操作10行數(shù)據(jù)基本需要5分鐘左右，為了優(yōu)化問(wèn)題，vba源碼里在操作數(shù)據(jù)前，先讓excel關(guān)閉自動(dòng)刷新屏幕和關(guān)閉自動(dòng)重算功能，當(dāng)數(shù)據(jù)填寫(xiě)完畢并格式化好文本后，再次開(kāi)啟自動(dòng)重算和自動(dòng)刷新屏幕，這時(shí)會(huì)發(fā)現(xiàn)自動(dòng)排單時(shí)間由原來(lái)5分鐘變?yōu)?2秒鐘。
|
|
QQ好友和群
QQ空間
騰訊微博
騰訊朋友
收藏
淘帖
頂
踩
