owen9399

回復 10# GBKEE

大大你好:
不知檔案 那裡要修改
    輸入公司表格(練習0214).rar (15.01 KB)

下載次數: 3

2012-2-14 17:40

謝謝

GBKEE

回復 11# owen9399
8#     Set Rng = .AutoFilter.Range.Columns(6).Cells                            '[自動篩選]的第6欄
這行沒有複製到
Sub 按鈕3_Click() 的程式 你重新 複製到你的檔案再試試看
交帳資料庫 : 日期的格式 請修改為 "yyyy/mm/dd" 格式 如圖

下載 (74.67 KB)

2012-2-14 17:55

owen9399

回復 10# GBKEE


請問 大大 詳細問題 於word檔
該如何解決

    輸入公司表格(練習0215).rar (16.9 KB)

下載次數: 3

2012-2-15 10:33

    輸入公司表格[請問大大如何解決0215].rar (258.3 KB)

下載次數: 5

2012-2-15 10:34

GBKEE

回復 13# owen9399
你附檔中  Sheet("交貨資料庫")  VBA  的Codename 為 Sheet2
                 Sheet("進貨資料庫")  VBA  的Codename 為 Sheet3
Sheet1 的事件程式碼 :輸入序號  或用下拉式選單      直接秀出公司名稱

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim xM
   
3.     If Intersect(Target, Range("A2:A11")) Is Nothing And Intersect(Target, Range("J2:J11")) Is Nothing _
   
4.     Or Target(1) = "" Or Target.Count > 1 Then Exit Sub
   
5.     xM = Application.Match(Target, [公司序號].Columns(1), 0)
   
6.     Target(1).Cells(1, 2) = [公司序號].Cells(xM, 2)
   
7. End Sub
   
8. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
9.     On Error Resume Next
   
10.     [序號].Validation.Delete
    
11.     If Intersect(Target, Range("A2:A11")) Is Nothing And Intersect(Target, Range("J2:J11")) Is Nothing _
    
12.     Then Exit Sub
    
13.     Range("Q2", [Q2].End(xlDown)).Resize(, 2).Name = "公司序號"
    
14.     Target.Name = "序號"
    
15.     With [序號].Validation
    
16.         .Delete
    
17.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
18.         Operator:=xlBetween, Formula1:="=" & [公司序號].Columns(1).Address
    
19.     End With
    
20. End Sub

複製代碼

Module1的程式碼

1. Sub 按鈕1_Click()
   
2.     Dim Rng As Range
   
3.      Set Rng = Sheet1.Range("A2:G11").SpecialCells(xlCellTypeVisible)
   
4.      With Sheet2.Range("A65536").End(xlUp).Offset(1)
   
5.         .Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
   
6.         .CurrentRegion.Borders.LineStyle = 1    '畫線
   
7.         .CurrentRegion.Borders.ColorIndex = 1   '上色
   
8.      End With
   
9.     Rng.ClearContents
   
10. End Sub
    
11. Sub 按鈕2_Click()
    
12. Dim Rng As Range
    
13.      Set Rng = Sheet1.Range("J2:N11").SpecialCells(xlCellTypeVisible)
    
14.     With Sheets("進貨資料庫").Range("A65536").End(xlUp).Offset(1)
    
15.         .Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
    
16.         .CurrentRegion.Borders.LineStyle = 1
    
17.         .CurrentRegion.Borders.ColorIndex = 1
    
18.     End With
    
19.     Rng.ClearContents
    
20. End Sub
    
21. Sub 按鈕3_Click()
    
22.     Dim Rng As Range, S As String, xi As Integer
    
23.     Dim Sh As Worksheet
    
24.      Set Sh = Sheets("日報表")              ' 日報表
    
25.      Sh.Cells.Clear
    
26.        With Sheets("交帳資料庫")
    
27.          If .AutoFilterMode Then .AutoFilterMode = False                         '取消篩選
    
28.             .Range("a1").AutoFilter                                                '[自動篩選] 篩選出一個清單
    
29.              Set Rng = .AutoFilter.Range.Columns(6).Cells                            '[自動篩選]的第6欄
    
30.              For xi = 2 To Rng.Count                                                  '處裡:  第二欄 單元格
    
31.                 If InStr(S, "," & Rng(xi) & ",") = False Then                       '檢查 儲存格 是否已出現過
    
32.                     .Range("a1").AutoFilter Field:=6, Criteria1:=Rng(xi).Text             '沒出現: 指定為篩選值
    
33.                     S = S & "," & Rng(xi) & ","                                          '加入已出現過的字串中
    
34.                     .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Rows.Count, "b").End(xlUp).Offset(2)   '複製: 資料表中篩選出的資料
    
35.                     Sh.Cells(Rows.Count, "b").End(xlUp).Offset(2).CurrentRegion.Borders.LineStyle = 1
    
36.                     Sh.Cells(Rows.Count, "b").End(xlUp).Offset(2).CurrentRegion.Borders.ColorIndex = 1
    
37.              End If
    
38.            Next
    
39.           .AutoFilterMode = False                     '取消篩選
    
40.    End With
    
41.    Sh.Activate
    
42. End Sub

複製代碼

owen9399

回復 14# GBKEE


    謝謝大大指導

可是 有問題想請教 :   1.現在出現  輸入公司序號  卻無法帶出  相關公司名稱
                       如   序號101001    卻要自行輸入 公司名稱
                       無法同步   
                      2.輸入交帳 或 進貨 的表格 , 卻無法 自動畫好格線 ,日報表 也是

如附件 所示


輸入公司表格(練習0215)-1.rar (18.55 KB)

下載次數: 5

2012-2-15 14:19

感恩

GBKEE

回復 15# owen9399
2.輸入交帳 或 進貨 的表格 , 卻無法 自動畫好格線 ,日報表 也是    14# 已更新

Sheet1 的事件程式碼 : 輸入序號  或用下拉式選單      直接秀出公司名稱
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
以上的2程序是針對 Sheet1 而寫的, 要放到Sheet1.


ThisWorkbook 事件
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)