Board logo

標題: [發問] 自動產生 編號新增 [打印本頁]
作者: prince120101    時間: 2015-1-12 17:53     標題: 自動產生 編號新增

各位大大 可幫忙看看 指導一下 謝謝@@
本程序動作流程
右方 K12:k14
"領料批號"(有使用資料驗證>清單 抓取左邊D4:D10"領料批號" 號碼)
"使用日期"
"使用尺數"
key入後按"領料"
它會依key入的"領料批號"
去搜尋左方D4:D10"領料批號"
在下方插入儲存格 d5:h5
會把 右邊key 入的 "領料批號" "尺數" "日期" 帶入
尺數 會順便 計算 55-5 = 50   


Q1 當搜尋時 它會 先搜尋到 批號後 再去搜尋 後方 H4:H6 1.2到後最一碼時 新增3 自動新增將資料
  1. Sub 進貨()

  3.     If Range("k6").Value = "" Or Range("k7").Value = "" Then
  4.     MsgBox ("資料未填入")
  5.     Exit Sub
  6.     End If
  7.    
  8.     Range("a1").Select
  9.     Selection.End(xlDown).Select
  10.     Range("a" & ActiveCell.Row + 1) = Range("k6").Value
  11.     Range("b" & ActiveCell.Row + 1) = Range("k7").Value
  12.      
  13.     Cells(Rows.Count, "$L").End(xlUp).Offset(1).Value = Range("k6").Value & Range("k7").Value
  14.     With Cells(Rows.Count, "$d").End(xlUp).Offset(1)
  15.     .Value = Range("k6").Value & "001"
  16.     .AutoFill Destination:=.Resize(Val(Range("k7"))), Type:=xlFillSeries
  17.     End With
  18.    
  19.     Range("A3:B1001").Select
  20.     Selection.Sort Key1:=Range("A3"), Order1:=xlDescending, Header:=xlGuess, _
  21.     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  22.     :=xlStroke, DataOption1:=xlSortNormal
  23.     'A:C的排序
  24.    
  25.     Range("D3:H1001").Select
  26.     Selection.Sort Key1:=Range("D3"), Order1:=xlDescending, Header:=xlGuess, _
  27.     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  28.     :=xlStroke, DataOption1:=xlSortNormal
  29.     'D:H的排序
  30.    
  31.     Range("k6:k7").Value = ""
  32.    
  33.     Range("a1").Select
  34.    
  35.     MsgBox "處理完成"
  36.    
  37. End Sub
複製代碼
  1. Sub 領料()
  2.    
  3.    
  4.     If Range("k12").Value = "" Or Range("k13").Value = "" Or Range("k14").Value = "" Then
  5.     MsgBox ("資料未填入")
  6.     Exit Sub
  7.     End If
  8.    
  9.     Dim f_cell, f_range   As Range
  10.     Set f_range = Columns("D")
  11.                      
  12.     Set f_cell = f_range.Find([K12].Value)
  13.     If f_cell Is Nothing Then MsgBox ("查無此批號") Else f_cell.Select
  14.     Selection.Offset(0, 2).Select
  15.     ActiveCell.Value = Range("K13").Value
  16.     Selection.Offset(0, 1).Select
  17.     ActiveCell.Value = Range("K14").Value
  18.     Selection.Offset(1, -3).Resize(, 5).Select
  19.     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  20.     Selection.Offset(0, 0).Resize(, 1).Select
  21.     ActiveCell.Value = Range("K12").Value
  22.     Selection.Offset(0, 1).Select
  23.     ActiveCell.Value = Selection.Offset(-1, 0).Value - Selection.Offset(-1, 2).Value
  24.    
  25.     'Range("k12").Value = ""
  26.     'Range("k14").Value = ""

  28.     'Range("a1").Select
  29.    
  30.     MsgBox "處理完成"
  31.    
  32.     '儲存格自動抓取電腦日期
  33.     'DATE(YEAR(TODAY()),MONTH(TODAY()),DAY(TODAY()))
  34.    
  35. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)