返回列表 上一主題 發帖

[發問] 自動清除功能

[發問] 自動清除功能

本帖最後由 PJChen 於 2017-7-25 22:36 編輯

請幫幫忙,這個程式已進入最後階段就完成了...

來源檔有1064列
目的檔有1073列
當來源檔把有資料的範圍A:AA複製到目的檔B:AB後,自動清除目的檔1065:1073列的字(要能Delete一整列但不要刪除列,因為目的檔的AC欄之後還有公式)

注意事項:
1. 這個程式測試過沒問題,只是當目的檔資料多於來源檔時,我希望增加一項清除"多餘資料"的功能
2. 清除多餘資料的寫法,要能自動偵測,因為來源檔及目的檔的資料隨時會有變動,所以不能用Delete 第?列:第?列的寫法
3. 目的檔中的1102~1104列有計算公式,我大約都會讓它與資料保持10列以上的距離,所以請把這個也考量進去,它不能被Delete
4. 請儘可能不要修改原先的程式

  1. Sub 庫存更新()
  2. '
  3. '
  4. '

  5. '
  6.     Dim Msg As Boolean, W As Workbook, Wb As Workbook  'W As "來源檔"      Wb As "目的檔"
  7.    
  8.     'Boolean 型態的預設值為 False
  9.     '*******Workbooks 開啟的活頁簿物件集合****
  10.     For Each W In Workbooks
  11.         If UCase(W.Name) = UCase("庫存資料表.xlsx") Then  'UCase的功能是什麼?
  12.             Msg = True  '檔案已開啟
  13.             Exit For
  14.         End If
  15.     Next
  16.     '*****************************************
  17.     If Msg = True Then '檔案已開啟
  18.         Set W = Workbooks("庫存資料表.xlsx")
  19.     Else               '檔案尚未打開時
  20.         Set W = Workbooks.Open("Q:\00_科毅\出貨文件連結\FromERP\庫存資料表.xlsx")
  21.     End If

  22.     '*****************************************
  23.     If Msg = True Then '檔案已開啟
  24.         Set Wb = Workbooks("ERP_Data.xlsx")
  25.     Else               '檔案尚未打開時
  26.         Set Wb = Workbooks.Open("Q:\00_科毅\出貨文件連結\ERP_Data.xlsx")
  27.     End If

  28.     '*****************************************Sorting以.Range("L1")為首
  29. Windows("庫存資料表.xlsx").Activate
  30.     Range("G1").Select
  31.     Selection.AutoFilter  '建立自動篩選
  32.     Range("G2").Select
  33. ActiveWindow.FreezePanes = True '凍結window
  34. 'ActiveWindow.FreezePanes = False '取消凍結window
  35. With Workbooks("庫存資料表.xlsx")
  36.    With .Sheets("庫存資料表")
  37.    Set b = .Range("L1").CurrentRegion
  38. A = Array("L", "F") '若有其他Sorting順位也可加入
  39.     .AutoFilter.Sort.SortFields.Clear
  40.     For i = 0 To 1   '指A = Array("L", "F") 有幾個sorting項目,2個就是0 To 1
  41.        .AutoFilter.Sort.SortFields.Add Key:=b.Columns(A(i)) _
  42.         , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  43.         xlSortNormal
  44.     Next
  45.     With .AutoFilter.Sort
  46.         .Header = xlYes
  47.         .MatchCase = False
  48.         .Orientation = xlTopToBottom
  49.         .SortMethod = xlPinYin
  50.         .Apply
  51.     End With
  52.   End With
  53. End With
  54. W.Save
  55.         'Workbooks("庫存資料表.xlsx").Close True    '存檔後關閉檔案
  56.         
  57.     '*****************************************
  58.     With W.Sheets("庫存資料表")
  59.         Set A = Intersect(.UsedRange, .Range("A:AA")).SpecialCells(xlCellTypeVisible)  '只選擇有資料的範圍
  60.      End With
  61.         
  62.      With Wb
  63.         'a.Copy .Sheets("庫存").Range("B1")  '完全複製到sheet的B1
  64.         '*************************************
  65.         A.Copy
  66.         .Sheets("庫存").Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
  67.         '*************************************
  68.         Application.CutCopyMode = False      '***不處於剪下或複製模式
  69.         '.Close True    '目的檔存檔後關閉檔案
  70.    Wb.Save   '目的檔存檔
  71.     End With
  72.     W.Close False '來源檔關閉檔案(不會問是否存檔)
  73. End Sub
複製代碼

回復 9# GBKEE
找了4天,終於發現不能sorting的原因...

TOP

請高人指點:

情形一,單獨排序時沒問題
  1. Option Explicit
  2. Dim 目的檔 As Workbook, 來源檔 As Workbook
  3. Sub sorting()
  4.     Dim xRng As Range
  5.      File_settings 目的檔, "ERP_Data.xlsx"
  6.     With 目的檔.Sheets("庫存")
  7.         .Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
  8.     End With
  9.     目的檔.Save
  10. End Sub

  11. '**********來源檔是同VBA報表指令的資料夾\FromERP\*********
  12. Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
  13.     Dim xPath As String
  14.     xPath = ThisWorkbook.Path & "\"
  15.     If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
  16.     On Error Resume Next
  17.     Set xFile = Workbooks(工作頁)
  18.     If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
  19.     If xFile.Name = "" Then
  20.         MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
  21.         End
  22.     End If
  23. End Sub
複製代碼
情形2,在以下中排序,卻一直排錯,是哪裡出問題?
  1. Option Explicit
  2. Dim 目的檔 As Workbook, 來源檔 As Workbook
  3. Sub 庫存更新()
  4.     Dim xRng As Range
  5.     File_settings 來源檔, "庫存資料表.xlsx"
  6.     File_settings 目的檔, "ERP_Data.xlsx"
  7. '*********************************************************
  8.     With 來源檔.Sheets(1)
  9.         Set xRng = .UsedRange  'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
  10.         xRng.Copy 'A:AA複製到目的檔B:AB
  11.     End With
  12.     With 目的檔.Sheets("庫存")
  13.        .Range("B1").PasteSpecial xlPasteValues '選擇性貼上
  14.     End With
  15.     With 目的檔.Sheets("庫存")
  16.         .Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
  17.     End With
  18.     來源檔.Close False
  19.     目的檔.Save
  20. End Sub
  21. '**********來源檔是同VBA報表指令的資料夾\FromERP\*********
  22. Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
  23.     Dim xPath As String
  24.     xPath = ThisWorkbook.Path & "\"
  25.     If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
  26.     On Error Resume Next
  27.     Set xFile = Workbooks(工作頁)
  28.     If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
  29.     If xFile.Name = "" Then
  30.         MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
  31.         End
  32.     End If
  33. End Sub
複製代碼

TOP

回復 9# GBKEE

大大,
請教sorting的問題,這個程式原本是在來源檔sorting,現在我把它改到目的檔,執行貼的動作後再sorting,為何就不能執行sorting動作呢?
  1. Option Explicit
  2. Dim 目的檔 As Workbook, 來源檔 As Workbook
  3. Sub 庫存更新()
  4.     Dim xRng As Range
  5.     File_settings 來源檔, "庫存資料表.xlsx"
  6.     File_settings 目的檔, "ERP_Data.xlsx"
  7. '*********************************************************
  8.     With 來源檔.Sheets(1)
  9.         Set xRng = .UsedRange  'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
  10.         xRng.Copy 'A:AA複製到目的檔B:AB
  11.     End With
  12.     With 目的檔.Sheets("庫存")
  13.        .Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
  14.         .Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
  15.         .Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
  16.     End With
  17.     來源檔.Close False
  18.     目的檔.Save
  19. End Sub
  20. '**********來源檔是同VBA報表指令的資料夾\FromERP\*********
  21. Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
  22.     Dim xPath As String
  23.     xPath = ThisWorkbook.Path & "\"
  24.     If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
  25.     On Error Resume Next
  26.     Set xFile = Workbooks(工作頁)
  27.     If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
  28.     If xFile.Name = "" Then
  29.         MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
  30.         End
  31.     End If
  32. End Sub
複製代碼

TOP

回復 9# GBKEE

感謝大大說明...

TOP

回復 8# PJChen
With 來源檔.Sheets(1)    '這物件是工作表
        .Cells.Sort Key1:=Columns("L"), Key2:=.Columns("F"), Header:=xlYes
        '** 沒有一點的   Columns("L"), 是指作用中工作表的Columns("L")
         '** 如恰巧作用中工作表是,來源檔.Sheets(1),,不會有錯誤發生的
       '**這是小地方很容易疏忽的
        Set xRng = .UsedRange    'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
        xRng.Copy 'A:AA複製到目的檔B:AB
    End With
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# GBKEE

真太神奇了,..大大
現在正常了,為什麼少了"."差這麼多?...謝謝你了,真是太苦惱人了.

TOP

回復 6# PJChen
抱歉了,2個地方少加 " ."
再試試看

With 來源檔.Sheets(1)
        .Cells.Sort Key1:= .Columns("L"), Key2:= .Columns("F"), Header:=xlYes
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE

大大,

我又試了好幾遍,還是跟之前說的一樣,必須先開啟ERP_Data.xlsx,執行才會正常..
我PO上讓您執行看看.
Try_20170729.rar (709.34 KB)

TOP

回復 4# PJChen

1) 來源檔與目的檔同時事先開啟,或同時不要開啟,它都無法執行??
2) 先開啟目的檔,再執行巨集這時它會自行打開來源檔,這樣就可以完全執行也會先排序再貼上.    ??

Sub 庫存更新(), 這程序你不是要放在VBA報表指令.XLSM
程式碼 有指定  來源檔與目的檔, 可以不管事先開啟,或沒開啟的問題
  1. File_settings 來源檔, "庫存資料表.xlsx"
  2.     File_settings 目的檔, "ERP_Data.xlsx"
  3. '**********來源檔是同VBA報表指令的資料夾\FromERP\*********
  4. If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
複製代碼
2#程式碼已更新 再試試看
你4#的程式碼執沒錯ㄚ
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 滴水成河。粒米成蘿,勿輕己靈,勿以善小而不為。
返回列表 上一主題