1234567
返回列表 上一主題 發帖

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

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

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 

有您真好勳章
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兔年全勤獎章
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 

有您真好勳章
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

emma

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

有您真好勳章
10#
發表於 2012-11-2 18:52 | 只看該作者
回復 9# GBKEE


    謝謝GBKEE版大的耐心指導，依您循循善誘的方試讓我自行找出我要的答案了，非常感謝您的用心^^
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Target_Row As String, xi As Integer, xi_Row As String
  3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
  4.        'Intersect物件
  5.         Target_Row = Target(, 1) & "," & Target(, 3) & "," & Target(, 5)    '這裡自行修改 連接不連續位置
  6.         xi = 7
  7.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
  8.         xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 3))), ",")
  9.         If xi_Row = Target_Row Then Exit Sub
  10.            xi = xi + 1
  11.         Loop
  12.         Sheets("sheet2").Cells(xi, 1).Resize(, 3) = Split(Target_Row, ",")
  13.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
  14.     End If
  15. End Sub
複製代碼
這樣執行出的是我想要的結果，應該沒錯吧?!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2012-11-2 18:14 | 只看該作者
回復 8# emma
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Target_Row As String, xi As Integer, xi_Row As String
  3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
  4.         'Intersect物件
  5.         Target_Row = 第一欄 & "," & 第三欄 & "," & 第五欄    '這裡自行修改 連接不連續位置
  6.         xi = 7
  7.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
  8.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 3))), ",")
  9.            If xi_Row = Target_Row Then Exit Sub
  10.            xi = xi + 1
  11.         Loop
  12.         Sheets("sheet2").Cells(xi, 1).Resize(, 3) = Split(Target_Row, ",")
  13.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
  14.     End If
  15. End Sub
複製代碼

TOP

emma

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

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


    GBKEE版大，不好意思，我又想到另一個問題，如果帶到Sheet2中的不是連續的欄位呢?
    例如只有第一欄、第三欄、第五欄
    Zip Code        、Area、Scope
    要如何更改呢?

    麻煩您了，謝謝^^

TOP

emma

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

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


    哇，真的沒想到可以做得出來這樣的效果，謝謝GBKEE版大，我要好好努力融會貫通一下，太開心了，非常的感謝您^^

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-11-1 18:03 | 只看該作者
回復 5# emma
試試看
  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("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
  6.     ElseIf Target.Address(0, 0) = "B1" Then
  7.         Range("A3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
  8.     End If
  9. End Sub
  10. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  11.     Dim Target_Row As String, xi As Integer, xi_Row As String
  12.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
  13.         'Intersect物件
  14.         Target_Row = Join(Application.Transpose(Application.Transpose(Target.Resize(, 5))), ",")
  15.         'Join 函數:傳回一個字串，該字串是透過連結某個陣列中的多個子字串而建立的。
  16.         xi = 7
  17.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
  18.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 5))), ",")
  19.            If xi_Row = Target_Row Then Exit Sub
  20.            xi = xi + 1
  21.         Loop
  22.         Sheets("sheet2").Cells(xi, 1).Resize(, 5) = Split(Target_Row, ",")
  23.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
  24.     End If
  25. End Sub
複製代碼

TOP

        靜思自在 : 人的眼睛長在前面，只看到別人的缺點，絲毫看不到自己的缺點。
1234567
返回列表 上一主題