自動清除功能 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 自動清除功能

返回列表下一主題上一主題發帖

[發問] 自動清除功能

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

11^# 跳轉到 »

發表於 2017-8-13 00:50 | 只看該作者

回復 9# GBKEE

大大,
請教sorting的問題,這個程式原本是在來源檔sorting,現在我把它改到目的檔,執行貼的動作後再sorting,為何就不能執行sorting動作呢？

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
'*********************************************************
With 來源檔.Sheets(1)
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
來源檔.Close False
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

12^#

發表於 2017-8-15 22:49 | 只看該作者

請高人指點：

情形一,單獨排序時沒問題

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub sorting()
Dim xRng As Range
File_settings 目的檔, "ERP_Data.xlsx"
With 目的檔.Sheets("庫存")
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

情形2,在以下中排序,卻一直排錯,是哪裡出問題？

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
'*********************************************************
With 來源檔.Sheets(1)
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上
End With
With 目的檔.Sheets("庫存")
.Cells.Sort Key1:=.Columns("AD"), Key2:=.Columns("G"), Header:=xlYes
End With
來源檔.Close False
目的檔.Save
End Sub
'**********來源檔是同VBA報表指令的資料夾\FromERP\*********
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

13^#

發表於 2017-8-19 21:32 | 只看該作者

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

靜思自在 : 多做多得。少做多失。

返回列表下一主題上一主題