- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
8#
發表於 2012-2-14 13:24
| 只看該作者
回復 7# owen9399
Shets("輸入資料")- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim xM
- If Intersect(Target, Range("A2:A11")) Is Nothing Or Target(1) = "" Then Exit Sub
- xM = Application.Match(Target, [公司序號].Columns(1), 0)
- Target.Cells(1, 2) = [公司序號].Cells(xM, 2)
- End Sub
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- On Error Resume Next
- [序號].Validation.Delete
- If Intersect(Target, Range("A2:A11")) Is Nothing Then Exit Sub
- Range("Q2", [Q2].End(xlDown)).Resize(, 2).Name = "公司序號"
- Target.Name = "序號"
- With [序號].Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
- Operator:=xlBetween, Formula1:="=" & [公司序號].Columns(1).Address
- End With
- End Sub
- Sub 按鈕3_Click()
- Dim Rng As Range, S As String, xi As Integer
- Dim Sh As Worksheet
- Set Sh = Sheets("日報表") ' 日報表
- Sh.Cells.Clear
- With Sheets("交帳資料庫")
- If .AutoFilterMode Then .AutoFilterMode = False '取消篩選
- .Range("a1").AutoFilter '[自動篩選] 篩選出一個清單
- Set Rng = .AutoFilter.Range.Columns(6).Cells '[自動篩選]的第6欄
- For xi = 2 To Rng.Count '處裡: 第二欄 單元格
- If InStr(S, "," & Rng(xi) & ",") = False Then '檢查 儲存格 是否已出現過
- .Range("a1").AutoFilter Field:=6, Criteria1:=Rng(xi).Text '沒出現: 指定為篩選值
- S = S & "," & Rng(xi) & "," '加入已出現過的字串中
- .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Rows.Count, "b").End(xlUp).Offset(2) '複製: 資料表中篩選出的資料
- End If
- Next
- .AutoFilterMode = False '取消篩選
- End With
- Sh.Activate
- End Sub
|
|
發表於 2012-2-8 11:19
| 
