返回列表 上一主題 發帖

請問我如何將庫存的活頁的資料,將它儲存到各活頁簿?

flask

帖子
40 
主題
10 
精華
0 
積分
83 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2011-6-3 
最後登錄
2020-10-1 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-6-3 10:22 | 只看該作者

請問我如何將庫存的活頁的資料,將它儲存到各活頁簿?

請問我如何將庫存的活頁的資料,將它儲存到各活頁簿做加總,例如:100A在6/1當天總供買了多少個或賣了多少個,把它存到台北的活頁中像黃色的樣子.謝謝你能幫忙. TEST.rar (5.88 KB)
收藏 分享

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
2#
發表於 2011-6-4 07:41 | 只看該作者
回復 1# flask


    我覺得你的資料如果是這樣會比較好處理
    分到其他工作表之後要做彙總也比較方便
[attach]6490[/attach]
字典兩各字 還真難理解

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
3#
發表於 2011-6-4 07:46 | 只看該作者
回復 2# freeffly


    圖貼不出來
    將資料格是改成附檔的格是應該會比較好
     
在A欄插入一欄當日期欄，原本有顯現台北那些的不要用縮排
這樣資料會比較好處理


[attach]6491[/attach]
字典兩各字 還真難理解

TOP

flask

帖子
40 
主題
10 
精華
0 
積分
83 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2011-6-3 
最後登錄
2020-10-1 
4#
發表於 2011-6-6 14:23 | 只看該作者
回復 2# freeffly


    圖貼不出來
    將資料格是改成附檔的格是應該會比較好
     
在A欄插入一欄當日期欄，原本有顯現台北那些的不要用縮排
這樣資料會比較好處理
freeffly大大謝謝你,看不太懂你的意思!

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-21 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2011-6-6 15:23 | 只看該作者
回復 4# flask
資料應遵守資料庫建立規則要做分析就比較方便

以你目前的資料要分頁檢視程式碼如下
  1. Sub ex()
  2. Dim a As Range
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. Set d = CreateObject("Scripting.Dictionary")
  5. With Sheets("庫存")
  6. i = 1
  7. Do Until .Cells(1, i) = ""
  8.   myday = .Cells(1, i).Value
  9.      For Each a In .Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp))
  10.      If IsEmpty(d(Val(a))) Then d(Val(a)) = a.Offset(, 1).Value
  11.         ar = Array(a.Offset(, 3), a.Offset(, 4))
  12.         If IsEmpty(dic(a & d(Val(a)))) Then
  13.            dic(a & d(Val(a))) = ar
  14.            Else
  15.            dic(a & d(Val(a))) = Array(dic(a & d(Val(a)))(0) + ar(0), dic(a & d(Val(a)))(1) + ar(1))
  16.         End If
  17.      Next
  18.      For Each ky In d.items
  19.         With Sheets(ky)
  20.         s = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
  21.         .Cells(1, s) = myday: .Cells(2, s) = "買": .Cells(2, s + 1) = "賣"
  22.            For Each a In .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
  23.                .Cells(a.Row, s).Resize(, 2) = dic(a & ky)
  24.            Next
  25.         End With
  26.      Next
  27.      dic.RemoveAll: d.RemoveAll
  28.      i = i + 5
  29.   Loop
  30. End With
  31. End Sub
複製代碼
學海無涯_不恥下問

TOP

flask

帖子
40 
主題
10 
精華
0 
積分
83 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2011-6-3 
最後登錄
2020-10-1 
6#
發表於 2011-6-6 17:08 | 只看該作者
謝謝Hsieh 超級版主,我知道你的意思了,也謝謝freeffly大大的幫忙...

TOP

flask

帖子
40 
主題
10 
精華
0 
積分
83 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2011-6-3 
最後登錄
2020-10-1 
7#
發表於 2011-6-8 15:07 | 只看該作者
Hsieh大大你好,我把它修改後,我想做設定革式化,如何不激活各活頁而能達到要求,

Sub ext()
Dim a As Range, i As Integer, c As Integer
Set dic = CreateObject("Scripting.Dictionary")
Set d = CreateObject("Scripting.Dictionary")
With Sheets("庫存")
i = 1
Do Until .Cells(1, i) = ""
  myday = .Cells(1, i).Value
     For Each a In .Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp))
   
        ar = Array(a.Offset(, 3), a.Offset(, 4))
        If IsEmpty(dic(a & d(Val(a)))) Then
           dic(a & d(Val(a))) = ar
           Else
           dic(a & d(Val(a))) = Array(dic(a & d(Val(a)))(0) + ar(0), dic(a & d(Val(a)))(1) + ar(1))
        End If
     Next
   
    For c = 2 To Worksheets.Count
   
        With Sheets(c)

        s = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1

        .Cells(1, s) = myday: .Cells(2, s) = "買進": .Cells(2, s + 1) = "賣出"

           For Each a In .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))

               .Cells(a.Row, s).Resize(, 2) = dic(a & d(Val(a)))
L = a.Row
           Next
       Sheets(c).Select        .UsedRange.Columns.AutoFit
        .Range(.Cells(2, s), .Cells(L, s)).Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="10000"
        Selection.FormatConditions(1).Font.ColorIndex = 3
        .Range(.Cells(2, s + 1), .Cells(L, s + 1)).Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="10000"
        Selection.FormatConditions(1).Font.ColorIndex = 5
        End With

     Next c

     dic.RemoveAll: d.RemoveAll

     i = i + 5

  Loop

End With

End Sub

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
253  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-21 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2011-6-8 15:40 | 只看該作者
.UsedRange.Columns.AutoFit
        .Range(.Cells(2, s), .Cells(L, s)).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="10000"
         .Range(.Cells(2, s), .Cells(L, s)).FormatConditions(1).Font.ColorIndex = 3
        .Range(.Cells(2, s + 1), .Cells(L, s + 1)).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="10000"
       .Range(.Cells(2, s + 1), .Cells(L, s + 1)).FormatConditions(1).Font.ColorIndex = 5
學海無涯_不恥下問

TOP

flask

帖子
40 
主題
10 
精華
0 
積分
83 
點名
0  
作業系統
winxp 
軟體版本
office2003 
閱讀權限
20 
註冊時間
2011-6-3 
最後登錄
2020-10-1 
9#
發表於 2011-6-8 17:42 | 只看該作者
謝謝Hsieh 大大,我終於了解了,謝謝你...

TOP

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
返回列表 上一主題