工作中發現每次排翻縫計劃時，總要把excel總表的訂單信息按每個訂單預定計劃領坯日期，復制到翻縫計劃表對應的日期下。今天就琢磨著能否一鍵搞定，實現自動翻縫排單，沒有想到41行代碼就能搞定每天要花20分鐘的工作量，把過程記錄下：
源表一（總表）
目標表二（翻縫計劃）
實現思路：
先獲取總表中選取行的所有行號并存入數組中，然后把所在行對應的計劃領坯日期去翻縫計劃中去查找，找到后獲得翻縫計劃表里
的日期所在的行號，并向下移動3行插入一空白行，再把總表中相應的訂單信息數據對應填下到翻縫計劃表的空白行中，同時把對應合約號以紅色底紋標識。
自動排單按鈕后的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 = "系統正在自動排單中，請耐心等待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("翻縫計劃").Range("k:k"), 1)
Sheets("翻縫計劃").Rows(currow + 3).Resize(1).Insert '翻縫日期下第二行處插入一空白行
'翻縫計劃表里寫入數據
Sheets("翻縫計劃").Cells(currow + 3, 1) = Sheets("總表").Cells(a(i), 2)
Sheets("翻縫計劃").Cells(currow + 3, 2) = Sheets("總表").Cells(a(i), 3)
Sheets("翻縫計劃").Cells(currow + 3, 3) = Sheets("總表").Cells(a(i), 4)
Sheets("翻縫計劃").Cells(currow + 3, 4) = Sheets("總表").Cells(a(i), 5)
Sheets("翻縫計劃").Cells(currow + 3, 5) = Sheets("總表").Cells(a(i), 6)
Sheets("翻縫計劃").Cells(currow + 3, 6) = Sheets("總表").Cells(a(i), 7)
Sheets("翻縫計劃").Cells(currow + 3, 7) = Sheets("總表").Cells(a(i), 8)
Sheets("翻縫計劃").Cells(currow + 3, 8) = Sheets("總表").Cells(a(i), 9)
Sheets("翻縫計劃").Cells(currow + 3, 9) = Sheets("總表").Cells(a(i), 10)
Sheets("翻縫計劃").Cells(currow + 3, 10) = Sheets("總表").Cells(a(i), 11)
Sheets("翻縫計劃").Cells(currow + 3, 11) = Sheets("總表").Cells(a(i), 12)
Sheets("翻縫計劃").Cells(currow + 3, 12) = Sheets("總表").Cells(a(i), 13)
Sheets("翻縫計劃").Cells(currow + 3, 13) = Sheets("總表").Cells(a(i), 14)
'格式化填寫的數據
Sheets("翻縫計劃").Cells(currow + 3, 2).Interior.Color = RGB(255, 0, 0) '設置合約號單元格的背景色為紅色
'Sheets("翻縫計劃").Activate
'' Sheets("翻縫計劃").Range(Cells(currow + 3, 1), Cells(currow + 3, 14)).Select
'With Selection
' .Font.Name = "宋體"
' .Font.Size = 10
' .Font.FontStyle = "常規"
' End With
'MsgBox currow
Next i
Application.Calculation = xlCalculationAutomatic
Application.MaxChange = 0.001
Application.ScreenUpdating = True
Application.StatusBar = "自動排單成功"
' Dim oe As New Excel.Application
' Dim ow As Workbook
' Dim os As Worksheet
' Set ow = oe.Workbooks.Open("E:\其他\外發加工單.xls")
' Set os = ow.Worksheets("加工單")
' oe.Visible = False
'For i = 1 To n
'a(i) 為選定單元格所在的行數
' ' 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、選定總表中需要排單的所在行（可以同時選多行）
2、點擊自動排單按鈕
編程中遇到的問題：
因為數據量很大，插入空白行-復制--黏貼，excel每次都要自動計算很耗時，操作10行數據基本需要5分鐘左右，為了優化問題，vba源碼里在操作數據前，先讓excel關閉自動刷新屏幕和關閉自動重算功能，當數據填寫完畢并格式化好文本后，再次開啟自動重算和自動刷新屏幕，這時會發現自動排單時間由原來5分鐘變為12秒鐘。
|
