返回列表 上一主題 發帖

[發問] 自動清除功能

[發問] 自動清除功能

本帖最後由 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. 請儘可能不要修改原先的程式

20170725.220357.jpg
2017-7-25 22:23
  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
複製代碼
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

本帖最後由 GBKEE 於 2017-7-29 19:19 編輯

回復 1# PJChen

UCase的功能是什麼?
你學習的不夠認真,不懂要看看說明

試試看
  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.     With 來源檔.Sheets(1)
  8.         .Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), Header:=xlYes
  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.         '自動清除目的檔1065:1073列
  15.         .Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 27).Clear
  16.     End With
  17.     來源檔.Close False
  18.     目的檔.Save
  19. End Sub
  20. Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
  21.     Dim xPath As String
  22.     xPath = ThisWorkbook.Path & "\"
  23.     If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
  24.     On Error Resume Next
  25.     Set xFile = Workbooks(工作頁)
  26.     If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
  27.     If xFile.Name = "" Then
  28.         MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
  29.         End
  30.     End If
  31. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

[版主管理留言]
  • GBKEE(2017/7/28 10:49): 2# 已指名排序程式碼可寫在那裡

回復 2# GBKEE

大大,

因為我原來的程式有排序功能,這個新的程式沒把來源檔的排序功能寫進去,
1. 可以幫忙把它加上去嗎?
2. 更新程式後,要把來源檔關閉.

我本來想原來的排序功能直接添上去,但因為你的寫法不同,我加上去的話它就整個不能執行了。
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

本帖最後由 GBKEE 於 2017-7-29 18:15 編輯

回復 2# GBKEE

大大,
請指導一下,我是要來源檔在未複製資料之前先排序,但總是有些問題
1) 來源檔與目的檔同時事先開啟,或同時不要開啟,它都無法執行
2) 先開啟目的檔,再執行巨集這時它會自行打開來源檔,這樣就可以完全執行也會先排序再貼上.
3) 我要怎麼修改讓它完全正常?
  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.     Set xRng = 來源檔.Sheets(1).UsedRange  'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
  8.    
  9.     '來源檔第一個工作表,排序 1) L  2)F
  10.      With 來源檔.Sheets(1).Range("A:AA")
  11.     .Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), _
  12. Header:=xlYes
  13.          xRng.Copy 'A:AA複製到目的檔B:AB
  14.     With 目的檔.Sheets("庫存")
  15.        .Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
  16.         
  17.         '自動清除目的檔1065:1073列
  18.         .Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
  19.         End With
  20.     End With
  21.     來源檔.Close False '來源檔關閉檔案(不會問是否存檔)
  22.     目的檔.Save
  23.    
  24.     End Sub
  25. Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
  26.     Dim xPath As String
  27.     xPath = ThisWorkbook.Path & "\"
  28.     If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
  29.     On Error Resume Next
  30.     Set xFile = Workbooks(工作頁)
  31.     If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
  32.     If xFile.Name = "" Then
  33.         MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
  34.         End
  35.     End If
  36. End Sub
複製代碼
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

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

回復 5# GBKEE

大大,

我又試了好幾遍,還是跟之前說的一樣,必須先開啟ERP_Data.xlsx,執行才會正常..
我PO上讓您執行看看.
Try_20170729.rar (709.34 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

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

With 來源檔.Sheets(1)
        .Cells.Sort Key1:= .Columns("L"), Key2:= .Columns("F"), Header:=xlYes
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

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

回復 9# GBKEE

感謝大大說明...

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題