麻辣家族討論版版 - Powered by Discuz! Board

Private Sub Workbook_Open() 'ThisWorkbook物件的程式碼
Dim E As Range
With Sheets("下拉選單").UsedRange.SpecialCells(xlCellTypeConstants)
For Each E In .Areas
E.CreateNames Top:=True '定義名稱出貨狀態顧客來源出貨方式 ...
Next
End With
End Sub

複製代碼

'201401 工作表物件的程式碼
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
If Target.Cells(1).Column < 4 Then Exit Sub 'A欄-C欄
Application.EnableEvents = False
With Target.Cells(1)
Select Case .Row
Case 6 '輸入郵遞區號
Set Rng = Sheets("郵遞區號").[a:a].Find(Target.Cells(1), lookat:=xlWhole)
If Not Rng Is Nothing Then
Target.Cells(1).Offset(1) = Rng.Offset(, 1)
Else
Target.Cells(1).Offset(1) = ""
End If
Case Is >= 23, 13 '輸入數量
Cells(13, .Column) = Application.WorksheetFunction.SumProduct([C23:C2022], [C23:C2022].Offset(, .Column - 3))
With Cells(17, .Column)
If Cells(13, .Column) <= Application.Sum([C14:C15].Offset(, .Column - 3)) Then
.Cells = Cells(16, .Column)
Else
.Cells = Cells(13, .Column) - Application.Sum([C14:C15].Offset(, .Column - 3)) + Cells(16, .Column)
End If
End With
Case 14 To 17 '輸入折扣A, 折扣B,運費
With Cells(17, .Column)
If Cells(13, .Column) <= Application.Sum([C14:C15].Offset(, .Column - 3)) Then
.Cells = Cells(16, .Column)
Else
.Cells = Cells(13, .Column) - Application.Sum([C14:C15].Offset(, .Column - 3)) + Cells(16, .Column)
End If
End With
End Select
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim S As String
Cells.Validation.Delete '刪除所有的儲存格的驗證(下拉選單)
With Target.Cells(1)
If .Column >= 4 Then
Select Case .Row
Case 2
S = "=出貨狀態"
Case 9
S = "=顧客來源"
Case 19
S = "=出貨方式"
End Select
End If
If Target.Cells(1).Address = "$C$1" Then S = "=" & Range("D1", [D1].End(xlToRight)).Address '序號的範圍
If S <> "" Then
With .Validation '儲存格的驗證(下拉選單)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=S '指定公式
End With
End If
End With
End Sub

複製代碼

Option Explicit
Private Sub Autoform_Click()
'開始製作
Dim Rng As Range, E As Range
With Sheets("201401")
Set Rng = .Range("D1", .[D1].End(xlToRight)).Find(.[C1], lookat:=xlWhole)
End With
If Rng Is Nothing Then MsgBox Rng & "找不到": Exit Sub
If Application.Sum(Rng.Range("A23:A2022")) <= 0 Then MsgBox Rng & "沒有輸入": Exit Sub
With Sheets("出貨單")
.Range("B3:B6,D3:D6,F3:F6,A8:F" & .Rows.Count) = ""
.Range("B3:B5") = Rng.Range("A3:A5").Value '複製基本資料
.Range("B6") = Rng.Range("A7") & Rng.Range("A8") '複製地址
.Range("D3") = Rng.Range("A10") '複製訂貨日期
.Range("D4") = Rng.Range("A18") '複製預期出貨日
.Range("D5") = Rng.Parent.Range("A2") & Rng '複製出貨序號
.Range("D6").Value = Rng.Range("A20") '複製物流編號
.Range("F3:F6") = Rng.Range("A14:A17").Value '複製計算金額
For Each E In Rng.Range("A23:A2022").SpecialCells(xlCellTypeConstants, xlNumbers) '有數字的儲存格
With .Cells(Rows.Count, 1).End(xlUp).Offset(1) '出貨單 A欄:由最後一列往上到有資料儲存格.Offset(1)
.Cells(1, 1) = E.Offset(, -E.Column + 1) '品項
.Cells(1, 2) = E.Offset(, -E.Column + 2) '品名
.Cells(1, 3) = E.Offset(, -E.Column + 3) '金額
.Cells(1, 4) = E '數量
.Cells(1, 5) = .Cells(1, 3) * .Cells(1, 4) '小計
End With
Next
.PageSetup.PrintArea = "$A1:$F$" & .Cells(Rows.Count, 1).End(xlUp).Row '設定印列範圍印表
.PrintOut '印表
End With
End Sub

複製代碼