1234567
返回列表 上一主題 發帖

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

emma

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

有您真好勳章
11# 跳轉到 »
發表於 2012-11-6 11:38 | 只看該作者
回復 9# GBKEE

GBKEE版大您好

不好意思，想再向您請教一下，之前設條件是希望Sheet1→Sheet2的資料每一筆只能被建置一次不可重複建置，
現在如果想改成允許同一筆資料無限次數可以點一次A欄某儲存格就出現至Sheet2一次的話，該如何更改程式呢?
我原先以為是「If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then」
這列的關係，但我把這行拿掉後，還是一筆只能出現一次，為什麼呢?

另外，如果使用者不小心點錯，或是點了之後想從Sheet2將某筆移除的話，可以嗎?移除的方式可以跟Sheet1一樣，
例如點選A8的儲存格，就將A8整列移除A9列遞補上A8那列的位置嗎?

謝謝^^

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2012-11-6 16:04 | 只看該作者
回復 11# emma
試試看
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)    '允許同一筆資料無限次數可以點一次A欄某儲存格就出現至Sheet2一次
  2.     Dim Target_Row As String
  3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
  4.        'Intersect物件:  Target包含在Range("A4", Range("A4").End(xlDown))*** 才要執行 ***
  5.         Target_Row = Target(, 1) & "," & Target(, 3) & "," & Target(, 5)    '這裡自行修改 連接不連續位置
  6.        Sheets("sheet2").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Split(Target_Row, ",")
  7.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
  8.     End If
  9. End Sub
  10. Sub Ex()  '果使用者不小心點錯:剛剛點錯 或 刪全部
  11.     Dim Target_Row As String, xi As Integer
  12.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), ActiveCell) Is Nothing Then
  13.         Target_Row = ActiveCell & "," & ActiveCell(, 3) & "," & ActiveCell(, 5)    '這裡自行修改 連接不連續位置
  14.         With Sheets("sheet2")
  15.             xi = .Range("a" & Rows.Count).End(xlUp).Row
  16.             Do While xi > 7
  17.                 If .Cells(xi, 1) & "," & .Cells(xi, 2) & "," & .Cells(xi, 3) = Target_Row Then
  18.                     .Cells(xi, 1).Resize(, 3).Delete xlUp
  19.                     Exit Sub  '剛剛點錯 只刪一次  ***將此成行註解掉 可刪全部
  20.                 End If
  21.                 xi = xi - 1
  22.             Loop
  23.        End With
  24.     End If
  25. End Sub
複製代碼

TOP

emma

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

有您真好勳章
13#
發表於 2012-11-6 18:53 | 只看該作者
本帖最後由 emma 於 2012-11-6 18:55 編輯

回復 12# GBKEE


    謝謝GBKEE版主，經測試的結果
    1.允許同一筆資料無限次數可以點一次A欄某儲存格就出現至Sheet2一次，這部份雖然執行沒有問題，但是實際使用後卻覺得不好使用
       因為必需離開原儲存格位置之後，再重新點選才會出現至Sheet2一次，例如點了A8，但沒有離開A8的位置再點一次A8
       是沒辦法繼續新增到Sheet2的。
    2.Sub Ex()  '如果使用者不小心點錯:剛剛點錯 或 刪全部，這段就完全沒有反應，不曉得是我哪裡有疏乎掉的地方?
    會在Sheet2所點選的A欄某儲存格旁出現「!」畫面如下圖↓
    1.jpg
   

    然後，不好意思，我可以再改變一下使用的方式嗎?
    想改變方式是如果在Zip Code前面多一欄筆數，例如在A8輸入所想要的筆數3筆後離開A8，A6輸入所想要的筆數7筆後離開A6
    那Sheet2會出現3筆A8列的指定欄位、7筆A6列的指定欄位，回去Sheet1修改A8筆數5筆、修改A6筆數4筆，
    最後Sheet2就會改為5筆A8列及4筆A6列的指定欄位，這樣可行嗎?
    不好意思，不曉得能不能明確表達我的意思，大致最後想呈現結果畫面如下:dizzy:
   

附件 VBA學習應用10111-2.rar (854.53 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2012-11-7 16:48 | 只看該作者
回復 13# emma
儲存格旁出現「!」                                                                                                         那是錯誤檢查的提示功能表,可察看工具->選項 ->錯誤檢查
Sub Ex()  '如果使用者不小心點錯:剛剛點錯 或 刪全部，這段就完全沒有反應， Ex() 這程式 不會 自動執行的.它不是工作表的觸動事件

  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)             '***它是工作表的觸動事件 ***
  3.     Dim Target_Row As String
  4.     If Target.Address(0, 0) = "D1" Then
  5.         Range("F3").AutoFilter Field:=6, Criteria1:="*" & Target & "*"
  6.     ElseIf Target.Address(0, 0) = "B1" Then
  7.         Range("B3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
  8.     ElseIf Not Application.Intersect(Range("b4", Range("b4").End(xlDown)).Offset(, -1), Target) Is Nothing Then
  9.         Target_Row = Target(, 2) & "," & Target(, 3) & "," & Target(, 4) & "," & Target(, 5) & "," & Target(, 6)
  10.         改變使用的方式 Target.Value, Target_Row
  11.     End If
  12. End Sub
  13. Private Sub 改變使用的方式(傳送次數 As Integer, 接收字串 As String)
  14.     Dim xi  As Integer, xi_次數 As Integer, xi_字串, Rng As Range
  15.     With Sheet2
  16.         xi = 7
  17.         Do While .Cells(xi, 1) <> ""
  18.             xi_字串 = Join(Application.Transpose(Application.Transpose(.Cells(xi, 1).Resize(, 5))), ",")
  19.             If xi_字串 = 接收字串 Then
  20.                 If xi_次數 < 傳送次數 Then
  21.                     xi_次數 = xi_次數 + 1
  22.                 ElseIf xi_次數 = 傳送次數 Then
  23.                     If Rng Is Nothing Then Set Rng = .Cells(xi, 1) Else Set Rng = Union(Rng, .Cells(xi, 1))
  24.                 End If
  25.             End If
  26.             xi = xi + 1
  27.         Loop
  28.         If xi_次數 < 傳送次數 Then
  29.             For xi = xi To xi + 傳送次數 - xi_次數 - 1
  30.                 .Cells(xi, 1).Resize(, 5) = Split(接收字串, ",")
  31.             Next
  32.             .Range("A6").CurrentRegion.Sort Key1:=.Range("A7"), Order1:=xlAscending, Key2:=.Range( _
  33.                         "B7"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
  34.                         :=False, Orientation:=xlTopToBottom, SortMethod:=xlStroke, DataOption1:= _
  35.                         xlSortNormal, DataOption2:=xlSortNormal
  36.         ElseIf Not Rng Is Nothing Then
  37.             Rng.EntireRow.Delete
  38.         End If
  39.     End With
  40. End Sub
複製代碼

TOP

emma

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

有您真好勳章
15#
發表於 2012-11-7 18:27 | 只看該作者
回復 14# GBKEE


    GBKEE版大，謝謝您，可以正常執行沒有問題，我在第一時間就看到您回復的文了，
    但試了老半天的原因是我想太多了，我以為您在給我出考題，
    要自行去尋找「改變使用的方式」、「傳送次數」、「接收字串」...等中文字部份的答案，
    於是就搞笑了@"@，最後直接貼上您的程式一字未改反而就正常了~"~
    我在自行好好研究一下，非常的感謝您^^

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
16#
發表於 2012-11-8 11:06 | 只看該作者
回復 15# emma


感謝兩位，一位提供想法，一位提供方法...是蠻實用的技巧....多謝...
50 字節以內
不支持自定義 Discuz! 代碼

TOP

emma

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

有您真好勳章
17#
發表於 2012-11-8 13:33 | 只看該作者
回復 14# GBKEE


    GBKEE版大您好，有一個地方想在向您請教一下，就是我在Sheet1插入一欄位於A欄的位置並隱藏，此欄預備為索引欄位用，
    但在使用過程中如未至Sheet2點選【清除】的按鈕前，功能一切正常，但點完按鈕後，就會有錯誤，
    試過幾個方式，但不明白為什麼會有這樣的錯誤，所以想再向您請教一下，
    問題很像是出現在Sheet1.UsedRange.Range("B4:B60300").Clear這段，是因為篩選的關係嗎?
  1. Sub 清除_Click()
  2.     Sheet2.UsedRange.Offset(1, 0).Clear
  3.     Sheet1.UsedRange.Range("B4:B60300").Clear  '這段如果拿掉的話，就不會有問題，但又希望使用者在用的時候B欄可以清除重新輸入想要的筆數
  4. End Sub
複製代碼





VBA學習應用10111-03.rar (861.73 KB)
麻煩您了，謝謝^^

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
18#
發表於 2012-11-8 14:36 | 只看該作者
回復 17# emma
修改如下 Target的第一個Cells(1)
  1. Target_Row = Target(, 2) & "," & Target(, 3) & "," & Target(, 4) & "," & Target(, 5) & "," & Target(, 6)
  2. 改變使用的方式 Target.Cells(1).Value, Target_Row
複製代碼


因為Sheet1.UsedRange..Range("B4:B60300").Clear 的範圍 導致
Private Sub Worksheet_Change(ByVal Target As Range)     
傳回 Target<=>.Range("B4:B60300") 不是單一的儲存格

改變使用的方式  Target.Value 是接收單一的值 **所以型態不同

TOP

emma

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

有您真好勳章
19#
發表於 2012-11-8 15:08 | 只看該作者
回復 18# GBKEE


    GBKEE版大，謝謝您，已沒有出錯誤的訊息，再向您請教一下，清除按鈕的↓這段是不是無法清除因篩選而隱藏起來的儲存格
   如果要將被隱藏起來儲存格裡面的值一起清除，是要讓Sheet1把篩選的欄位都放開再執行清空嗎?謝謝您^^
  1.     Sheet1.UsedRange.Range("B4:B60300").Clear
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
20#
發表於 2012-11-8 16:53 | 只看該作者
回復 19# emma
這問題你試試就知道

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
1234567
返回列表 上一主題