- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
14#
發表於 2012-11-7 16:48
| 只看該作者
回復 13# emma
儲存格旁出現「!」 那是錯誤檢查的提示功能表,可察看工具->選項 ->錯誤檢查
Sub Ex() '如果使用者不小心點錯:剛剛點錯 或 刪全部,這段就完全沒有反應, Ex() 這程式 不會 自動執行的.它不是工作表的觸動事件
- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range) '***它是工作表的觸動事件 ***
- Dim Target_Row As String
- If Target.Address(0, 0) = "D1" Then
- Range("F3").AutoFilter Field:=6, Criteria1:="*" & Target & "*"
- ElseIf Target.Address(0, 0) = "B1" Then
- Range("B3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
- ElseIf Not Application.Intersect(Range("b4", Range("b4").End(xlDown)).Offset(, -1), Target) Is Nothing Then
- Target_Row = Target(, 2) & "," & Target(, 3) & "," & Target(, 4) & "," & Target(, 5) & "," & Target(, 6)
- 改變使用的方式 Target.Value, Target_Row
- End If
- End Sub
- Private Sub 改變使用的方式(傳送次數 As Integer, 接收字串 As String)
- Dim xi As Integer, xi_次數 As Integer, xi_字串, Rng As Range
- With Sheet2
- xi = 7
- Do While .Cells(xi, 1) <> ""
- xi_字串 = Join(Application.Transpose(Application.Transpose(.Cells(xi, 1).Resize(, 5))), ",")
- If xi_字串 = 接收字串 Then
- If xi_次數 < 傳送次數 Then
- xi_次數 = xi_次數 + 1
- ElseIf xi_次數 = 傳送次數 Then
- If Rng Is Nothing Then Set Rng = .Cells(xi, 1) Else Set Rng = Union(Rng, .Cells(xi, 1))
- End If
- End If
- xi = xi + 1
- Loop
- If xi_次數 < 傳送次數 Then
- For xi = xi To xi + 傳送次數 - xi_次數 - 1
- .Cells(xi, 1).Resize(, 5) = Split(接收字串, ",")
- Next
- .Range("A6").CurrentRegion.Sort Key1:=.Range("A7"), Order1:=xlAscending, Key2:=.Range( _
- "B7"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
- :=False, Orientation:=xlTopToBottom, SortMethod:=xlStroke, DataOption1:= _
- xlSortNormal, DataOption2:=xlSortNormal
- ElseIf Not Rng Is Nothing Then
- Rng.EntireRow.Delete
- End If
- End With
- End Sub
複製代碼 |
|