- 帖子
- 110
- 主題
- 14
- 精華
- 0
- 積分
- 239
- 點名
- 0
- 作業系統
- win xp
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2010-8-2
- 最後登錄
- 2017-5-10
|
回復 44# GBKEE
GBKEE版大，真的非常的感謝您，我目前想要保有原有的功能再加上可以查詢出儲位，所以其實只要把儲位的那列
放進原本的程式中執行就可以了，只是我不曉得↓這句的語法要怎麼用才對，所以向您提問，另外，您所提供的各種方式，
我都想要試試，即便是現在不會採用，但如您所言，程式要多吸收才會進步，非常感謝您的解惑^^- Sheets("資料檔").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)
- 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
- Dim Ar(), A As Range
- If Target.Address(0, 0) = "E1" Then
- Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
- ElseIf Target.Address(0, 0) = "C1" Then
- Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
- End If
- With Sheet1
- If Application.Count(.Range("B:B")) > 0 Then
- For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
- 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 = "已結束"
- ElseIf A < A.Offset(, 4) Then
- m = "運費+手續費"
- ElseIf InStr(A.Offset(, 5), "推") And A > A.Offset(, 4) Then '包含
- m = "免運"
- ElseIf InStr(A.Offset(, 5), "推") = 0 And A > A.Offset(, 4) Then '不包含
- m = "運費"
- 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)
- s = s + 1
- Next
- End If
- End With
- With Sheets("查詢")
- If s > 0 Then
- Target = ""
- .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
- .Range("A4").CurrentRegion.Sort key1:=.[A4], Header:=xlYes
- [color=Red] Sheets("資料檔").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5) 'F欄:儲位[/color]
- End If
- End With
- End Sub
|
|
發表於 2012-11-20 14:55
| 
，謝謝您!!
