標題: excel vba 實現自動排單功能 [打印本頁]
作者: 51黑專家    時間: 2016-5-8 01:28
標題: excel vba 實現自動排單功能
           工作中發(fā)現每次排翻縫計劃時，總要把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 = "系統(tǒ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("翻縫計劃").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 = "常規(guī)"
  ' 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:\其他\外發(fā)加工單.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分鐘左右，為了優(yōu)化問題，vba源碼里在操作數據前，先讓excel關閉自動刷新屏幕和關閉自動重算功能，當數據填寫完畢并格式化好文本后，再次開啟自動重算和自動刷新屏幕，這時會發(fā)現自動排單時間由原來5分鐘變?yōu)?2秒鐘。  






歡迎光臨 (http://www.torrancerestoration.com/bbs/) Powered by Discuz! X3.1