Board logo

標題: [發問] [求助]輸入公司表格如何聯結 [打印本頁]
作者: owen9399    時間: 2012-2-8 11:19     標題: [求助]輸入公司表格如何聯結

本帖最後由 owen9399 於 2012-2-11 15:33 編輯

請問各位大大:

我有 製作一份 簡易的進銷存 公司清單
但是 不知 如何使 它們的資料 聯結

又 再度麻煩 各位高手

詳細遇到的問題     範本中有說明

感謝
[attach]9489[/attach]
作者: owen9399    時間: 2012-2-9 10:54

1.輸入資料  共分為 兩個區域:  一個是 交帳資料 輸入   ,另一個  是進貨資料 輸入
2.輸入後 分別存入 各區的儲存資料庫
3.日報表 與 年報表 分別 只是 顯示方式不同
4.庫存清單 是 總應付份數 與 進貨數量    的相加減, 而產生 退回.多領.尚欠等 進銷存的計算

希望 有大大能做出來  
本人  非常感謝
作者: owen9399    時間: 2012-2-10 17:05

我有新增對應的程式
於 輸入資料  共分為 兩個區域:  一個是 交帳資料 輸入   ,另一個  是進貨資料 輸入

但是 其他該如何設定

如附件[attach]9530[/attach]
作者: owen9399    時間: 2012-2-11 15:35

請問各位大大 可以先做出 日報表的連結嗎?

感恩!
作者: GBKEE    時間: 2012-2-11 17:53

回復 4# owen9399
日報表的連結嗎?
如何連結?? 沒說清楚
作者: owen9399    時間: 2012-2-12 11:22

回復 5# GBKEE


    大大你好:

連結的方式:

當輸入資料後,資料就會儲存在 交帳資料庫中 ,而日報表 就是 把交帳資料庫的資料 以日期區分出來

假設:
交帳資料表 輸入資料如下
公司序號        公司        張數        價格        應付份數        日期        備註
101001        王品        35        1500        35        2012/2/6       
101001        王品        50        1450        50        2012/2/6       
101003        西堤        80        1300        80        2012/2/6       
101001        王品        40        1450        40        2012/2/10       
101004        頂好        60        1200        60        2012/2/10       
101001        王品        10        1500        10        2012/2/13       
101005        家樂福        50        1300        50        2012/2/12       

而日報表 分別分類 顯示  如下:

                        日報表                2012/2/6       
公司序號        公司        張數        價格        應付份數        日期        備註
101001        王品        35        1500        35        2012/2/6       
101001        王品        50        1450        50        2012/2/6       
101003        西堤        80        1300        80        2012/2/6       
                                               


                        日報表                2012/2/10       
公司序號        公司        張數        股數        應付份數        日期        備註
101001        王品        40        1450        40        2012/2/10       
101004        頂好        60        1200        60        2012/2/10       

以此類推...

而且 當輸入 新資料的 公司 日期   ,就自動產生新的表格
作者: owen9399    時間: 2012-2-12 11:25

假設 輸入公司等資料 新增3筆 就產生  新的日報表
並 自動畫好 表格 + 日期 + 新增的資料3筆
作者: GBKEE    時間: 2012-2-14 13:24

回復 7# owen9399
Shets("輸入資料")
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim xM
  3.     If Intersect(Target, Range("A2:A11")) Is Nothing Or Target(1) = "" Then Exit Sub
  4.     xM = Application.Match(Target, [公司序號].Columns(1), 0)
  5.     Target.Cells(1, 2) = [公司序號].Cells(xM, 2)
  6. End Sub
  7. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  8.     On Error Resume Next
  9.     [序號].Validation.Delete
  10.     If Intersect(Target, Range("A2:A11")) Is Nothing Then Exit Sub
  11.     Range("Q2", [Q2].End(xlDown)).Resize(, 2).Name = "公司序號"
  12.     Target.Name = "序號"
  13.     With [序號].Validation
  14.         .Delete
  15.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
  16.         Operator:=xlBetween, Formula1:="=" & [公司序號].Columns(1).Address
  17.     End With
  18. End Sub
複製代碼
交帳資料庫 : 日期的格式 請修改為 "yyyy/mm/dd" 格式
  1. Sub 按鈕3_Click()
  2.     Dim Rng As Range, S As String, xi As Integer
  3.     Dim Sh As Worksheet
  4.     Set Sh = Sheets("日報表")                                                 ' 日報表
  5.     Sh.Cells.Clear
  6.     With Sheets("交帳資料庫")
  7.         If .AutoFilterMode Then .AutoFilterMode = False                         '取消篩選
  8.         .Range("a1").AutoFilter                                                 '[自動篩選] 篩選出一個清單
  9.         Set Rng = .AutoFilter.Range.Columns(6).Cells                            '[自動篩選]的第6欄
  10.         For xi = 2 To Rng.Count                                                  '處裡:  第二欄 單元格
  11.             If InStr(S, "," & Rng(xi) & ",") = False Then                       '檢查 儲存格 是否已出現過
  12.                 .Range("a1").AutoFilter Field:=6, Criteria1:=Rng(xi).Text             '沒出現: 指定為篩選值
  13.                 S = S & "," & Rng(xi) & ","                                          '加入已出現過的字串中
  14.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Rows.Count, "b").End(xlUp).Offset(2)   '複製: 資料表中篩選出的資料
  15.             End If
  16.         Next
  17.         .AutoFilterMode = False                                                  '取消篩選
  18.     End With
  19.     Sh.Activate
  20. End Sub
複製代碼
作者: owen9399    時間: 2012-2-14 15:35

本帖最後由 GBKEE 於 2012-2-14 16:21 編輯

回復 8# GBKEE


    謝謝大大指導  
'因為有測試但是程式出現 錯誤 , 不知如何修正
權限 快達成
作者: GBKEE    時間: 2012-2-14 16:19

回復 9# owen9399
傳檔看看
作者: owen9399    時間: 2012-2-14 17:41

回復 10# GBKEE

大大你好:
不知檔案 那裡要修改
    [attach]9581[/attach]

謝謝
作者: GBKEE    時間: 2012-2-14 17:58

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

[attach]9582[/attach]
作者: owen9399    時間: 2012-2-15 10:35

回復 10# GBKEE


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

    [attach]9590[/attach]

    [attach]9591[/attach]
作者: GBKEE    時間: 2012-2-15 12:27

本帖最後由 GBKEE 於 2012-2-15 14:42 編輯

回復 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    時間: 2012-2-15 14:20

回復 14# GBKEE


    謝謝大大指導

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

如附件 所示


[attach]9598[/attach]

感恩
作者: GBKEE    時間: 2012-2-15 14:34

本帖最後由 GBKEE 於 2012-2-15 14:43 編輯

回復 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)



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)