Hsieh

回復 30# emma

我覺得妳的需求不像是查詢資料
比較像是把資料檔工作表B欄有數値的列
經過處理後寫入查詢工作表
試試附件
VBAtest7.rar (17.2 KB)

下載次數: 10

2012-11-17 21:43

emma

回復 31# Hsieh


    非常感謝Hsieh版大、GBKEE版大，得二位高手的協助，我已綜合出我想要的版本了，
    Hsieh版大，其實我也只是照使用者想要的功能去研究，是希望使用者在輸入數量時，能簡化人員用人工判斷的條件，以減少人工判斷的錯誤，所以就...成了這樣的工作表了。

PS.我想要再請教一個問題，能不能讓使用者在輸入完數量，將該筆數量寫至【查詢】工作表，就立即清空該儲存格?例如在B3輸入完1234離開後，將B3列資料帶入【查詢】工作表裡，再立即將B3的儲存格清空!!有這種方法嗎?

附上最後完成的練習範本，或許版大們可以更理解我問PS.的方法用意
VBAtest9.rar (36.62 KB)

下載次數: 8

2012-11-20 13:43

cea

謝謝分享
感覺好多要學的喔
大大們都太強了

emma

回復 31# Hsieh


    Hsieh版大，還有一個地方想順便請教一下，就是↓這個地方可不可以改成「包含」與「不包含」的用法?但我不知道不包含的語法是什麼，所以這麼試的結果當然是跟我說語法錯誤啦 ，謝謝您!!

1. ElseIf A.Offset(, 5) = "推" And A > A.Offset(, 4) Then
   
2.          m = "免運"
   
3.          ElseIf A.Offset(, 5) <> "推" And A > A.Offset(, 4) Then

複製代碼

1. ElseIf A.Offset(, 5) Like "*推*" And A > A.Offset(, 4) Then
   
2.          m = "免運"
   
3.          ElseIf A.Offset(, 5) Not Like "*推*" And A > A.Offset(, 4) Then

複製代碼

GBKEE

回復 34# emma

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String, s As Integer, dot As Long, k As Integer, m As String
   
4.     Dim Ar(), A As Range
   
5.     If Target.Address(0, 0) = "E1" Then
   
6.         Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
7.     ElseIf Target.Address(0, 0) = "C1" Then
   
8.         Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
9.     End If
   
10.     With Sheet1
    
11.         If Application.Count(.Range("B:B")) > 0 Then
    
12.             For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
13.                 ReDim Preserve Ar(s)
    
14.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
15.                 k = IIf(Sheets("查詢").[B1] = "總店", 10, 11)
    
16.                 If A.Offset(, 7) < Date Then
    
17.                     m = "已結束"
    
18.                 ElseIf A < A.Offset(, 4) Then
    
19.                     m = "運費+手續費"
    
20.                 ElseIf InStr(A.Offset(, 5), "推") And A > A.Offset(, 4) Then       '包含
    
21.                     m = "免運"
    
22.                 ElseIf InStr(A.Offset(, 5), "推") = 0 And A > A.Offset(, 4) Then   '不包含
    
23.                     m = "運費"
    
24.                 End If
    
25.                 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)
    
26.                 s = s + 1
    
27.             Next
    
28.         End If
    
29.     End With
    
30.     With Sheets("查詢")
    
31.         If s > 0 Then
    
32.             Target = ""
    
33.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
34.             .Range("A4").CurrentRegion.Sort key1:=.[A4], Header:=xlYes
    
35.         End If
    
36.     End With
    
37. End Sub

複製代碼

emma

回復 35# GBKEE


    GBKEE版大謝謝您，還有一個新的想法，但這一個功能的可能性不曉得能不能做到，如果使用者在數量的欄位KEY某個關鍵字，如KEY"0"或非數字例"ABC"這種代號的話，就另外跳出一個輸入數量的視窗，讓使用者KEY入數量，目的是為了某些特殊的情形要避開計算「免運」的部份，無論該項產品本身是否有符合「免運」的條件，只要用這個方式輸入數量的話，就是不去判斷免運的部份，只會有「已結束」、「運費」、「運費+手續費」這三種判斷而以。

希望能獲得解惑，謝謝!!

emma

回復 35# GBKEE


    GBKEE版大，不好意思，想再向您請教一下，如想讓「資料檔」工作表的C2顯示最後一筆使用者輸入的儲位，應該要怎麼做呢?
    我試了Sheets("資料檔").[C2] = A.Offset(, k).Value，但會顯示「沒有設定物件變數或with區塊變數」為什麼呢?
    麻煩您了，謝謝^^
VBAtest11.rar (19.24 KB)

下載次數: 5

2012-12-18 14:37

GBKEE

回復 37# emma
試試看

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String, s As Integer, dot As Long, k As Integer, m As String
   
4.     Dim Ar(), A As Range
   
5.     Application.EnableEvents = False              '****
   
6.     If Target.Address(0, 0) = "E1" Then
   
7.         Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
8.     ElseIf Target.Address(0, 0) = "C1" Then
   
9.         Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
10.     Else
    
11.         Exit Sub                                  '*****
    
12.     End If
    
13.     With Sheet1
    
14.         If Application.Count(.Range("B:B")) > 0 Then
    
15.             For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
16.                 ReDim Preserve Ar(s)
    
17.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
18.                 k = IIf(Sheets("查詢").[B1] = "總店", 10, 11)
    
19.                 If A.Offset(, 7) < Date Then
    
20.                     m = "已結束"
    
21.                 ElseIf A < A.Offset(, 4) Then
    
22.                     m = "運費+手續費"
    
23.                 ElseIf InStr(A.Offset(, 5), "推") And A > A.Offset(, 4) Then       '包含
    
24.                     m = "免運"
    
25.                 ElseIf InStr(A.Offset(, 5), "推") = 0 And A > A.Offset(, 4) Then   '不包含
    
26.                     m = "運費"
    
27.                 End If
    
28.                 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)
    
29.                 s = s + 1
    
30.             Next
    
31.         End If
    
32.     End With
    
33.     With Sheets("查詢")
    
34.         If s > 0 Then
    
35.             Target = ""
    
36.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
37.             Sheets("資料檔").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'F欄:儲位
    
38.         End If
    
39.     End With
    
40.     Application.EnableEvents = True                 '*******
    
41. End Sub

複製代碼

emma

回復 38# GBKEE

  GBKEE版主，試了，但是沒反應，連原先的功能也不見了，怎麼會這樣呢??
    VBAtest11.rar (19.08 KB)

下載次數: 7

2012-12-18 16:30

GBKEE

回復 39# emma
輸入: 信
到[查詢]看看

下載 (41.85 KB)

2012-12-18 17:01