麻辣家族討論版版 - Powered by Discuz! Board

標題: 請問我如何將庫存的活頁的資料,將它儲存到各活頁簿? [打印本頁]

作者: flask 時間: 2011-6-3 10:22 標題: 請問我如何將庫存的活頁的資料,將它儲存到各活頁簿?

請問我如何將庫存的活頁的資料,將它儲存到各活頁簿做加總,例如:100A在6/1當天總供買了多少個或賣了多少個,把它存到台北的活頁中像黃色的樣子.謝謝你能幫忙.[attach]6477[/attach]

作者: freeffly 時間: 2011-6-4 07:41

回復 1# flask

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

作者: freeffly 時間: 2011-6-4 07:46

回復 2# freeffly

圖貼不出來
將資料格是改成附檔的格是應該會比較好

在A欄插入一欄當日期欄，原本有顯現台北那些的不要用縮排
這樣資料會比較好處理

[attach]6491[/attach]

作者: flask 時間: 2011-6-6 14:23

回復 2# freeffly

圖貼不出來
將資料格是改成附檔的格是應該會比較好

在A欄插入一欄當日期欄，原本有顯現台北那些的不要用縮排
這樣資料會比較好處理
freeffly大大謝謝你,看不太懂你的意思!

作者: Hsieh 時間: 2011-6-6 15:23

回復 4# flask
資料應遵守資料庫建立規則要做分析就比較方便
[attach]6505[/attach]
以你目前的資料要分頁檢視程式碼如下

Sub ex()
Dim a As Range
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))
If IsEmpty(d(Val(a))) Then d(Val(a)) = a.Offset(, 1).Value
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 Each ky In d.items
With Sheets(ky)
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 & ky)
Next
End With
Next
dic.RemoveAll: d.RemoveAll
i = i + 5
Loop
End With
End Sub

複製代碼

作者: flask 時間: 2011-6-6 17:08

謝謝Hsieh 超級版主,我知道你的意思了,也謝謝freeffly大大的幫忙...

作者: flask 時間: 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

作者: Hsieh 時間: 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

作者: flask 時間: 2011-6-8 17:42

謝謝Hsieh 大大,我終於了解了,謝謝你...

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