返回列表 上一主題 發帖

請協助加入新元素

回復 1# 317
  1. Sub CopyData()
  2. Dim 列 As Integer
  3. Dim 貨物編號 As String
  4. Dim 貨物名稱 As String
  5. Dim 類型 As String
  6. Dim 數量 As Integer
  7. Set d = CreateObject("Scripting.Dictionary")
  8. 列 = ActiveCell.Row
  9. 選擇用途 = Cells(列, 2)
  10. 貨物編號 = Cells(列, 3)
  11. 貨物名稱 = Cells(列, 4)
  12. 類型 = Cells(列, 5)
  13. 數量 = Cells(列, 8)

  14. With Workbooks("b.xls").Sheets("sheet1")
  15. For Each a In .[AB3:AB6]
  16. d(a.Value) = a.Interior.ColorIndex
  17. Next
  18. .[A65536].End(xlUp).Offset(1, 0).Resize(, 5).Interior.ColorIndex = d(選擇用途)
  19. .[A65536].End(xlUp).Offset(1, 0).Resize(, 5).Value = Array(選擇用途, 貨物編號, 貨物名稱, 類型, 數量)
  20. End With
  21. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 3# 317

用排序可以嗎?
  1. Sub CopyData()
  2. Dim 列 As Integer
  3. Dim 貨物編號 As String
  4. Dim 貨物名稱 As String
  5. Dim 類型 As String
  6. Dim 數量 As Integer
  7. Set d = CreateObject("Scripting.Dictionary")
  8. 列 = ActiveCell.Row
  9. 選擇用途 = Cells(列, 2)
  10. 貨物編號 = Cells(列, 3)
  11. 貨物名稱 = Cells(列, 4)
  12. 類型 = Cells(列, 5)
  13. 數量 = Cells(列, 8)
  14. Windows("b.xls").Activate
  15. With Workbooks("b.xls").Sheets("sheet1")
  16. .Select
  17. For Each a In .[AB3:AB6]
  18. d(a.Value) = a.Interior.ColorIndex
  19. Next
  20. Set a = .[A65536].End(xlUp).Offset(1, 0).Resize(, 5)
  21. a.Interior.ColorIndex = d(選擇用途)
  22. a.Value = Array(選擇用途, 貨物編號, 貨物名稱, 類型, 數量)
  23. a.Select
  24. .Range(.[A2:E2], .[A2:E2].End(xlDown)).Sort key1:=.[A2], Header:=xlYes
  25. End With
  26. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題