篩選?關鍵字?查詢? - Excel程式區

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

21^# 跳轉到 »

發表於 2012-11-8 17:18 | 只看該作者

回復 20# GBKEE

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

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

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

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

22^#

發表於 2012-11-8 18:07 | 只看該作者

回復 20# GBKEE

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

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

複製代碼

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

23^#

發表於 2012-11-9 18:59 | 只看該作者

回復 20# GBKEE

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

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

VBAtest7.rar (14.21 KB)

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

24^#

發表於 2012-11-15 13:57 | 只看該作者

回復 20# GBKEE

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

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

複製代碼

test2.rar (8.96 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

25^#

發表於 2012-11-15 15:49 | 只看該作者

回復 24# emma

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

複製代碼

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

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

26^#

發表於 2012-11-15 16:57 | 只看該作者

回復 25# GBKEE

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

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

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

27^#

發表於 2012-11-15 17:17 | 只看該作者

回復 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版大的幫忙^^

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 257
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-28

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

28^#

發表於 2012-11-15 22:48 | 只看該作者

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ar(), A As Range
If Target.Address <> "$B$1" Then Exit Sub
If Application.CountA(Range([A5], Cells(Rows.Count, 1))) > 0 Then
For Each A In Range([A5], Cells(Rows.Count, 1).End(xlUp))
ReDim Preserve Ar(s)
Ar(s) = Application.Transpose(Application.Transpose(A.Resize(, 8)))
s = s + 1
Next
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 Or A.Offset(, 9) = "") And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
k = IIf(Target = "總店", 10, 11)
If A < A.Offset(, 4) Then
m = "運費+手續費"
ElseIf A.Offset(, 5) = "推" And A > A.Offset(, 4) Then
m = "免運"
ElseIf A.Offset(, 5) <> "推" 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
If s > 0 Then [A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
Range("A4").CurrentRegion.Sort key1:=[A4], Header:=xlYes
End Sub

複製代碼

VBAtest7.rar (19.28 KB)

學海無涯_不恥下問

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

29^#

發表於 2012-11-16 13:08 | 只看該作者

回復 28# Hsieh

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

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

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

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

TOP

emma

中學生 Rank: 2

帖子: 110
主題: 14
精華: 0
積分: 239
點名: 0
作業系統: win xp
軟體版本: office 2003
閱讀權限: 20
性別: 女
註冊時間: 2010-8-2
最後登錄: 2017-5-10

有您真好勳章

30^#

發表於 2012-11-16 18:39 | 只看該作者

回復 28# Hsieh

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

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

複製代碼

TOP

[發問] 篩選?關鍵字?查詢?

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]