emma

回復 20# GBKEE


    GBKEE版主，我已經有試過了(只是我是用手動的方式試)，所以才會這麼詢問，
   我想問的是，能用巨集寫手動去做的這些動作嗎?
    還是只能手動才能讓篩選的隱藏儲存格"全部"清空?操作手動動作的巨集是存在的嗎?謝謝^^

我手動的方式是將
Zip Code欄位的篩選改回「全部」
Scope   欄位的篩選改回「全部」
再到Sheet2點選「清除」的按鈕

↑可以用巨集省略這些步驟嗎?
指令是跟手動的步驟一樣嗎?

emma

回復 20# GBKEE


    謝謝GBKEE版主不厭其煩的回復我問的小問題，我剛剛已試出我要的答案了，非常感謝您的指導~~

1. Sub 清除_Click()
   
2.     Sheet2.UsedRange.Offset(1, 0).Clear
   
3.     Sheet1.UsedRange.Range("B4:B60300").Clear
   
4.     Sheet1.UsedRange.Range("C1").Clear
   
5.     Sheet1.UsedRange.Range("E1").Clear
   
6.     Sheet1.UsedRange.AutoFilter Field:=2
   
7.     Sheet1.UsedRange.AutoFilter Field:=6
   
8. End Sub

複製代碼

emma

回復 20# GBKEE


    GBKEE版大您好，想再向您請教一下，如果想將數量依使用者輸入的數量去新增至【查詢】工作表B欄裡，並帶出其他對應或計算出符合的欄位值，
詳如附件，請教該如何做呢?規則在【查詢】工作表中的欄位名稱有加入註解，謝謝您^^

目前附件【查詢】工作表中的欄位是希望可以最終顯示的結果

下載 (201.52 KB)

2012-11-9 18:14

下載 (104.03 KB)

2012-11-9 18:14

VBAtest7.rar (14.21 KB)

下載次數: 10

2012-11-9 18:54

emma

回復 20# GBKEE


    GBKEE版主，不好思意，因為實在找不出錯誤的地方，可以勞動您大駕幫忙看一下哪裡有問題嗎?
    執行測試結果在輸入第一筆及第二筆資料是沒問題，但第三筆之後就會錯亂了，假設第一筆在商品F輸入數量後，第二筆的位置沒限制，但第三筆就一定要在商品F之前(例商品E)才會帶入   Sheet2，在商品F之後(例商品N)就帶不過去Sheet2，為什麼會這樣??

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)  '***它是工作表的觸動事件 ***
   
3.     Dim Target_Row As String, xi As Integer, xi_Row As String
   
4.     If Not Application.Intersect(Range("A2", Range("A2").End(xlDown)), Target) Is Nothing Then
   
5.         'Intersect物件
   
6.         Target_Row = Target(, 1) & "," & Target(, 2)
   
7. 'Join 函數:傳回一個字串，該字串是透過連結某個陣列中的多個子字串而建立的。
   
8.         xi = 5
   
9.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
   
10.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 2))), ",")
    
11.            If xi_Row = Target_Row Then Exit Sub
    
12.            xi = xi + 1
    
13.         Loop
    
14.         Sheets("sheet2").Cells(xi, 1).Resize(, 2) = Split(Target_Row, ",")
    
15.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
    
16.     End If
    
17. End Sub

複製代碼

test2.rar (8.96 KB)

下載次數: 5

2012-11-15 13:48

GBKEE

回復 24# emma

1. If Not Application.Intersect(Range("A2", Range("A2").End(xlDown)), Target) Is Nothing Then
   
2. '改成 B2 -[B2].End(xlDown) 間資料列向左位移一欄 (A欄)  
   
3. If Not Application.Intersect(Range("B2", Range("B2").End(xlDown).Offset(, -1)), Target) Is Nothing Then

複製代碼

23#
圖1與圖2相對應的資料[宏全]為何會是2筆資料
累積點數,活動狀態 兩欄 是如何判斷!!

emma

回復 25# GBKEE


    GBKEE版大，謝謝您^^，test2已正常~~~
    「宏全」會有二筆是因為，宏全可以有多筆不同的「數量」，使用者每輸入一次就會帶一筆到【查詢】裡，這也是我研究test2的原因
     累積點數的判斷是產品有分為「有點數累積」跟「沒有點數累積」的所以才在資料檔中建一欄位為【點數累積】，【點數累積】欄位為「V」就是「有點數累積」，【點數累積】欄位為「X」就是沒有「沒有點數累積」，但又存在第二個判斷的條件，就是「有點數累積」的有期間限制，而且每一件產品的累積期間不同，其判斷條件就設在「點數累積結束」這個欄位，如未KEY上結束日期前(就是保留空值"")，才能計算累積點數，第三個條件就是累積點數是以1000為單位，小於1000就沒有累積，例如1000~1999算累積1000、2000~2999算累積2000，以此類推。
　　活動狀態是想要判斷運費是否要計算，在「資料檔」工作表中，【主推商品】欄位有「推」字的話，就可以免運，但前提是要數量有大於【基本量】欄位，如果沒有符合上述條件的話，就要加計運費，當【主推商品】欄位沒有「推」字的話，數量又小於【基本量】欄位時，除運費另計外還要再加特別處理的手續費，但是當今天(當下的日期，如101/11/15)的日期超過【最後預購日】時，就不用做這些判斷，直接顯示「已結束」，因為商品已無法下單了。

所以我還滿頭大的，不曉得這樣是否能傳達清楚，謝謝GBKEE版大的幫忙^^

emma

回復 25# GBKEE

對不起，更正一下 關於「活動狀態」的說明
     1.如果數量小於【基本量】就是要收取「運費」+「手續費」
     2.如果數量大於【基本量】但是【主推商品】欄位沒有「推」字的話，只要收取「運費」
     3.如果數量大於【基本量】但是【主推商品】欄位且有「推」字的話，就「免運」
     ps.當【最後預購日】(例101/11/15不含當天)，也就是今天的【最後預購日期】如果是101/11/14(含)之前的話，就直接顯示「已結束」


補充說明「累積點數」的判斷
1.【點數累積】欄位為「V」且【最後預購日】(例101/11/15含當天)，就計算累積點數，累積點數是以1000為單位，小於1000就沒有累積，例如1000~1999算累積1000、2000~2999算累積2000，以此類推。
2.如果沒有完全符合上述的條件，例如【點數累積】欄位為「V」且【最後預購日】為101/11/14(今天以前)、【點數累積】欄位為「X」、數量小於1000，這些的點數就不用去計算了。

　　謝謝GBKEE版大的幫忙^^

Hsieh

回復 27# emma
是不是這樣效果?

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Ar(), A As Range
   
3. If Target.Address <> "$B$1" Then Exit Sub
   
4. If Application.CountA(Range([A5], Cells(Rows.Count, 1))) > 0 Then
   
5.    For Each A In Range([A5], Cells(Rows.Count, 1).End(xlUp))
   
6.       ReDim Preserve Ar(s)
   
7.       Ar(s) = Application.Transpose(Application.Transpose(A.Resize(, 8)))
   
8.       s = s + 1
   
9.     Next
   
10. End If
    
11.    
    
12. With Sheet1
    
13. If Application.Count(.Range("B:B")) > 0 Then
    
14.    For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
15.    ReDim Preserve Ar(s)
    
16.    If A.Offset(, 8) = "V" And (A.Offset(, 9) > Date Or A.Offset(, 9) = "") And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
17.    k = IIf(Target = "總店", 10, 11)
    
18.       If A < A.Offset(, 4) Then
    
19.          m = "運費+手續費"
    
20.          ElseIf A.Offset(, 5) = "推" And A > A.Offset(, 4) Then
    
21.          m = "免運"
    
22.          ElseIf A.Offset(, 5) <> "推" 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. If s > 0 Then [A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
31. Range("A4").CurrentRegion.Sort key1:=[A4], Header:=xlYes
    
32. End Sub

複製代碼

VBAtest7.rar (19.28 KB)

下載次數: 12

2012-11-15 22:46

emma

回復 28# Hsieh

是的，謝謝Hsieh版大，大致上是這樣的效果，但是初步使用我想如果有二個地方可以調整一下的話會更好
1.工作表有【分店】與【總店】共通查詢使用，但大部份使用的人員只會只查自己所在的點，所以如果是【總店】應該就會固定查詢【總店】
在【資料檔】輸入數量後必需至【查詢】再點選「店別」的欄位才會帶出資料，可以先依預設的「店別」直接帶出資料嗎?
而且只要切換一次「店別」就會將【資料檔】所有輸入數量的欄位再帶進【查詢】一次(如圖一至圖三)

2.活動狀態少了判斷【最後預購日】這個條件，如果今天的日期大於【最後預購日】就顯示「已結束」提醒使用者此筆商品無法被購買。

下載 (198.39 KB)

2012-11-16 12:52

下載 (96.47 KB)

2012-11-16 12:52

下載 (110.53 KB)

2012-11-16 12:52

↓以此圖為例，除了【欣錩】以外，其他筆的活動狀況如果可以設為已結束的話就更好了。

下載 (128.93 KB)

2012-11-16 12:52

當然，我也會自己努力試試怎麼完成自己想要的效果，謝謝Hsieh版大的幫忙^^

emma

回復 28# Hsieh

Hsieh版大，不好意思，恕小的愚笨，我試了一整天才試出關於活動狀態的部份而以，所以只好再求救一下，
此方法把程式寫在【查詢】的「店別」欄位裡，所以只有在變動到「店別」的欄位時才能更新到【查詢】的內容，
所以如果想讓使用者在【資料檔】一變更數量欄位時就可以更新至【查詢】工作表的話，應該要如何設定才好呢?
目前的工作表不是不能使用，但是使用上有二個問題
一是必需將【資料檔】裡的數量欄位先清除掉，重新只key入想新增的數量，再至【查詢】工作表選擇店別，就可以順利新增，
但如果沒有全部清除的話，資料會混在一起分不清「儲位」是哪個店別的「儲位」，希望您能明白我在敘述什麼，殘念的希望週末回來後，
能再有所精進，祝您週末愉快^^

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Ar(), A As Range
   
3. If Target.Address <> "$B$1" Then Exit Sub
   
4. If Application.CountA(Range([A5], Cells(Rows.Count, 1))) > 0 Then
   
5.    For Each A In Range([A5], Cells(Rows.Count, 1).End(xlUp))
   
6.       ReDim Preserve Ar(s)
   
7.       Ar(s) = Application.Transpose(Application.Transpose(A.Resize(, 8)))
   
8.       s = s + 1
   
9.     Next
   
10. End If
    
11.    
    
12. With Sheet1
    
13. If Application.Count(.Range("B:B")) > 0 Then
    
14.    For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
15.    ReDim Preserve Ar(s)
    
16.    If A.Offset(, 8) = "V" And (A.Offset(, 9) > Date Or A.Offset(, 9) = "") And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
17.    k = IIf(Target = "總店", 10, 11)
    
18.       If A.Offset(, 7) >= Date Then
    
19.       If A < A.Offset(, 4) Then
    
20.          m = "運費+手續費"
    
21.          ElseIf A.Offset(, 5) = "推" And A > A.Offset(, 4) Then
    
22.          m = "免運"
    
23.          ElseIf A.Offset(, 5) <> "推" And A > A.Offset(, 4) Then
    
24.          m = "運費"
    
25.       End If
    
26.    Else
    
27.    m = "已結束"
    
28.    End If
    
29.    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)
    
30.    s = s + 1
    
31. Next
    
32. End If
    
33. End With
    
34. If s > 0 Then [A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
35. Range("A4").CurrentRegion.Sort key1:=[A4], Header:=xlYes
    
36. End Sub

複製代碼