- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
54#
發表於 2013-4-22 17:28
| 只看該作者
回復 53# emma - Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Target_Row As String, s As Integer, dot As Long, K As Integer, M As String, t As String
- Dim Ar(), A As Range, Rng As Range
- If Target.Address(0, 0) = "E1" Then
- Range("D3").AutoFilter Field:=4, Criteria1:="*" & Target & "*"
- ElseIf Target.Address(0, 0) = "C1" Then
- Range("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
- End If
- Application.EnableEvents = False '****
- Set Rng = Range("B4:B65536").SpecialCells(xlCellTypeVisible) '自動篩選後可見的儲存格
- If Application.Count(Rng) > 0 Then '可見的儲存格:有資料儲存格的總數>0
- Set Rng = Rng.SpecialCells(xlCellTypeConstants) '可見的儲存格:有資料的儲存格
- For Each A In Rng.Cells
- ReDim Preserve Ar(s)
- If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
- K = IIf(Sheets("查詢").[b1] = "總店", 10, 11)
- If A.Offset(, 7) < Date Then
- M = "已結束"
- t = "已出貨"
- ElseIf A < A.Offset(, 4) Then
- M = "運費+手續費"
- t = "未出貨"
- ElseIf InStr(A.Offset(, 5), "推") And A > A.Offset(, 4) Then '包含
- M = "免運"
- t = "未出貨"
- ElseIf InStr(A.Offset(, 5), "推") = 0 And A > A.Offset(, 4) Then '不包含
- M = "運費"
- t = "未出貨"
- End If
- Ar(s) = Array(A.Offset(, 2).Value, A.Value, A.Offset(, 3).Value, dot, A.Offset(, 12).Value, A.Offset(, K).Value, M, A.Offset(, 6).Value, A.Offset(, 7).Value, t)
- s = s + 1
- Next
- With UserForm2
- .TextBox1 = Ar(s - 1)(0)
- .TextBox2 = dot
- .TextBox3 = M
- .Show
- End With
- End If
- With Sheets("查詢")
- If s > 0 And UserForm2.Msg = False Then
- Target = ""
- .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 10) = Application.Transpose(Application.Transpose(Ar))
- .Range("A4").CurrentRegion.Sort Key1:=.[A4], Header:=xlYes
- Sheets("資料檔").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5) 'F欄:儲位
- End If
- End With
- Application.EnableEvents = True '*******
- End Sub
- Public Msg As Boolean '按下 [取消] 的公用變數
- Private Sub CommandButton1_Click()
- UserForm2.Hide
- End Sub
- 'UserForm2 須增加一CommandButton2 '取消按鈕
- Private Sub CommandButton2_Click()
- Msg = True ''按下 [取消] 按鈕為 True
- UserForm2.Hide
- End Sub
- Private Sub UserForm_Activate() 'UserForm 顯示時
- Msg = False '取消 [取消]按鈕
- End Sub
|
|
發表於 2013-1-2 14:18
| 
