- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-2-26
  
|
2#
發表於 2015-4-17 18:16
| 只看該作者
回復 1# maiko
剛不久前，我作了一個類似的，修改了一下，也不知是不是應你的要求！- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Address = [k3].Address Then
- Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter
- ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Clear
- ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Add Key:=Range( _
- "B2:B" & Cells(Rows.Count, 2).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
- xlSortNormal
- With ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort
- .Header = xlYes
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter
-
- shop = [k3]
- For Each Rng In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
- If Rng = shop Then
- K = K + 1
- If K = 1 Then
- Set Rn = Rng.Offset(0, 1)
- Else
- Set Rn = Union(Rn, Rng.Offset(0, 1))
- End If
- End If
- Next
- aa = Rn.Address
- If aa = "" Then
- Exit Sub
- Else
- With [L3].Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & aa
- .IgnoreBlank = True
- .InCellDropdown = True
- .InputTitle = ""
- .ErrorTitle = ""
- .InputMessage = ""
- .ErrorMessage = ""
- .IMEMode = xlIMEModeNoControl
- .ShowInput = True
- .ShowError = False
- End With
- End If
- [L3] = "請選擇日期"
- End If
- If Target.Address = [L3].Address Then
- For Each Rang In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
- If Rang = [k3] And Rang.Offset(0, 1) = [L3] Then
- [K5] = Rang.Offset(0, 2)
- [L5] = Rang.Offset(0, 5)
- End
- End If
- Next
- End If
- End Sub
|
|
