返回列表 上一主題 發帖

[發問] 如何把有填寫數量的品項從清單複製到到出貨單

lancerlot1980

帖子
1 
主題
1 
精華
0 
積分
3 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2014-4-3 
最後登錄
2014-4-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-4-4 00:08 | 只看該作者

[發問] 如何把有填寫數量的品項從清單複製到到出貨單

目標：想把在201401表中填好的訂購品資料，貼到出貨單下面。
想請問高手
1.如何才能把有填入數量的訂購品選出來，並複製到出貨單上。
2.如何讓出貨單的訂購品表格長度隨著有訂購的品項數變動，列印時較環保。
■■  也就是說客人指定3樣時，表格下列也只顯示3樣，而不需要多列印空白列數。■■
■■  而指定20樣時，表格也可以自動變成剛好20行，知道應該是用Offset觀念，但是不太知道怎麼寫。■■
3. 最後一個問題是檔案資料量沒有很多，但是就已經2.6MB了，有解決方式嗎？

Inquiry.rar (245.15 KB)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-4-5 16:43 | 只看該作者
回復 1# lancerlot1980
檔案資料量沒有很多，但是就已經2.6MB了，是公式太多下面的程式碼可替代公式.
  1. Private Sub Workbook_Open() 'ThisWorkbook物件的程式碼
  2.     Dim E As Range
  3.     With Sheets("下拉選單").UsedRange.SpecialCells(xlCellTypeConstants)
  4.         For Each E In .Areas
  5.             E.CreateNames Top:=True  '定義名稱 出貨狀態 顧客來源 出貨方式 ...
  6.         Next
  7.     End With
  8. End Sub
複製代碼
  1. '201401 工作表物件的程式碼
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim Rng As Range
  4.     If Target.Cells(1).Column < 4 Then Exit Sub  'A欄-C欄
  5.     Application.EnableEvents = False
  6.     With Target.Cells(1)
  7.         Select Case .Row
  8.             Case 6  '輸入 郵遞區號
  9.                 Set Rng = Sheets("郵遞區號").[a:a].Find(Target.Cells(1), lookat:=xlWhole)
  10.                 If Not Rng Is Nothing Then
  11.                     Target.Cells(1).Offset(1) = Rng.Offset(, 1)
  12.                 Else
  13.                     Target.Cells(1).Offset(1) = ""
  14.                 End If
  15.             Case Is >= 23, 13      '輸入 數量
  16.                 Cells(13, .Column) = Application.WorksheetFunction.SumProduct([C23:C2022], [C23:C2022].Offset(, .Column - 3))
  17.                 With Cells(17, .Column)
  18.                     If Cells(13, .Column) <= Application.Sum([C14:C15].Offset(, .Column - 3)) Then
  19.                         .Cells = Cells(16, .Column)
  20.                     Else
  21.                     .Cells = Cells(13, .Column) - Application.Sum([C14:C15].Offset(, .Column - 3)) + Cells(16, .Column)
  22.                     End If
  23.                 End With
  24.             Case 14 To 17       '輸入 折扣A, 折扣B,運費
  25.                 With Cells(17, .Column)
  26.                     If Cells(13, .Column) <= Application.Sum([C14:C15].Offset(, .Column - 3)) Then
  27.                         .Cells = Cells(16, .Column)
  28.                     Else
  29.                     .Cells = Cells(13, .Column) - Application.Sum([C14:C15].Offset(, .Column - 3)) + Cells(16, .Column)
  30.                     End If
  31.                 End With
  32.         End Select
  33.     End With
  34.     Application.EnableEvents = True
  35. End Sub
  36. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  37.     Dim S As String
  38.     Cells.Validation.Delete   '刪除 所有的儲存格的驗證(下拉選單)
  39.     With Target.Cells(1)
  40.         If .Column >= 4 Then
  41.             Select Case .Row
  42.                 Case 2
  43.                     S = "=出貨狀態"
  44.                 Case 9
  45.                     S = "=顧客來源"
  46.                 Case 19
  47.                     S = "=出貨方式"
  48.             End Select
  49.         End If
  50.         If Target.Cells(1).Address = "$C$1" Then S = "=" & Range("D1", [D1].End(xlToRight)).Address   '序號 的範圍
  51.         If S <> "" Then
  52.             With .Validation         '儲存格的驗證(下拉選單)
  53.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S '指定公式
  54.             End With
  55.         End If
  56.     End With
  57. End Sub
複製代碼
  1. Option Explicit
  2. Private Sub Autoform_Click()
  3.     '開始製作
  4.     Dim Rng As Range, E As Range
  5.     With Sheets("201401")
  6.         Set Rng = .Range("D1", .[D1].End(xlToRight)).Find(.[C1], lookat:=xlWhole)
  7.     End With
  8.     If Rng Is Nothing Then MsgBox Rng & "找不到": Exit Sub
  9.     If Application.Sum(Rng.Range("A23:A2022")) <= 0 Then MsgBox Rng & "沒有輸入": Exit Sub
  10.     With Sheets("出貨單")
  11.         .Range("B3:B6,D3:D6,F3:F6,A8:F" & .Rows.Count) = ""
  12.         .Range("B3:B5") = Rng.Range("A3:A5").Value              '複製基本資料
  13.         .Range("B6") = Rng.Range("A7") & Rng.Range("A8")        '複製地址
  14.         .Range("D3") = Rng.Range("A10")                         '複製訂貨日期
  15.         .Range("D4") = Rng.Range("A18")                         '複製預期出貨日
  16.         .Range("D5") = Rng.Parent.Range("A2") & Rng             '複製出貨序號
  17.         .Range("D6").Value = Rng.Range("A20")                   '複製物流編號
  18.         .Range("F3:F6") = Rng.Range("A14:A17").Value            '複製計算金額
  19.         For Each E In Rng.Range("A23:A2022").SpecialCells(xlCellTypeConstants, xlNumbers) '有數字的儲存格
  20.             With .Cells(Rows.Count, 1).End(xlUp).Offset(1)      '出貨單 A欄:由最後一列往上到有資料儲存格.Offset(1)
  21.                 .Cells(1, 1) = E.Offset(, -E.Column + 1)        '品項
  22.                 .Cells(1, 2) = E.Offset(, -E.Column + 2)        '品名
  23.                 .Cells(1, 3) = E.Offset(, -E.Column + 3)        '金額
  24.                 .Cells(1, 4) = E                                '數量
  25.                 .Cells(1, 5) = .Cells(1, 3) * .Cells(1, 4)      '小計
  26.             End With
  27.         Next
  28.         .PageSetup.PrintArea = "$A1:$F$" & .Cells(Rows.Count, 1).End(xlUp).Row  '設定印列範圍印表
  29.         .PrintOut  '印表
  30.     End With
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

touhou

帖子
6 
主題
0 
精華
0 
積分
9 
點名
0  
作業系統
windows 
軟體版本
Office 2007 
閱讀權限
10 
註冊時間
2014-7-14 
最後登錄
2015-5-26 
3#
發表於 2014-7-15 10:44 | 只看該作者
樓主分享方式跟我很類似,也有此需求,謝謝版主幫忙

TOP

        靜思自在 : 成功是優點的發揮，失敗是缺點的累積。
返回列表 上一主題