[發問] 排序後刪除特定攔位

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2013-1-23 09:28 | 只看該作者

回復 1# billchenfantasy
依你敘述的需求應該用一般Excel操作就可達成:
先將不必要的欄刪除 , 再到資料>排序(excel 2010) 設定即可

帖子: 25
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: windows 2007
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2013-1-22
最後登錄: 2014-4-29

3^#

發表於 2013-1-23 09:55 | 只看該作者

感謝您的回答其實是因為檔案很多資料長度範圍不一定，想開始學習VBA所致，我自己其實有先用錄製巨集的方式試過如下並設為兩個按鈕，新手學習請您包含
Private Sub CommandButton1_Click()
Dim uFile$
ChDrive "資料磁碟"
ChDir "資料路徑"
Source = Application.GetOpenFilename
With Workbooks.Open(Source)
For i = 1 To ActiveWorkbook.Sheets.Count
.Sheets(i).Copy after:=ThisWorkbook.Worksheets(Sheets.Count)
Next i
  .Close
End With
End Sub
以上是將資料匯入並開新的工作表(同時名稱為該資料檔)請問要如何設置自動命名為同一個工作表名稱?
----------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
Cells.Select
Cells.EntireColumn.AutoFit
Application.WindowState = xlMaximized
ActiveWorkbook.Worksheets("工作表名稱").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("工作表名稱").Sort.SortFields.Add Key:=Range( _
      "land_no_m的範圍"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
      xlSortTextAsNumbers
ActiveWorkbook.Worksheets("工作表名稱").Sort.SortFields.Add Key:=Range( _
      "land_no_c的範圍"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
      xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("工作表名稱").Sort
      .SetRange Range("資料全範圍")----->要怎麼設計無論資料多長都可以選起呢?是(.Range("A1").CurrentRegion)嗎
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
End With
Application.Width = 831
Application.Height = 810
Columns("A:C").Select
Range("C1").Activate
Selection.Delete Shift:=xlToLeft
Columns("B:F").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C

").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Range("J1").Select
End Sub
-------------------------------------------------------------
其實我是想指定刪除上述特定標題的欄位

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2013-1-23 11:32 | 只看該作者

回復 3# billchenfantasy
>> Private Sub CommandButton1_Click()
>> 以上是將資料匯入並開新的工作表(同時名稱為該資料檔)請問要如何設置自動命名為同一個工作表名稱?

不明白你的意思 , 你複製工作表過來時名字應該是和原本工作表一樣的

>>Private Sub CommandButton2_Click()

試試看
Private Sub CommandButton2_Click()
With Sheets("工作表名稱")
.[A1].CurrentRegion.Sort Key1:=.[E:E], Order1:=xlAscending, _
Key2:=.[F:F], Order2:=xlAscending, _
Header:=xlYes
.Range("A:C,E:I,K:L,Q:Q").Delete Shift:=xlToLeft
End With
End Sub

帖子: 25
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: windows 2007
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2013-1-22
最後登錄: 2014-4-29

5^#

發表於 2013-1-23 12:20 | 只看該作者

@@Private Sub CommandButton2_Click()
的OK了對於您的解答感謝萬分，我來好好研究一下
Private Sub CommandButton1_Click()的意思是說
"複製工作表過來時名字應該是和原本工作表一樣的"沒錯
因為我的檔案有很多，而且雖然內容格式一樣但檔名不一樣，我的想法是要怎麼樣
把不同檔名的檔案匯進來之後都可以執行Private Sub CommandButton2_Click()，
因為指定的With Sheets("工作表名稱")工作表名稱會變
等這個都了解了接下來再想下一步怎麼批次
再次謝謝你歐

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

6^#

發表於 2013-1-23 15:14 | 只看該作者

回復 5# billchenfantasy
同一活頁簿是不能有多個相同名稱的工作表

你要的批次處理是這樣嗎? (可選多個檔案)

Private Sub CommandButton1_Click()
Dim Source, f
'可選擇多個檔案
Source = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx),*.xls;*.xlsx", _
MultiSelect:=True)
If TypeName(Source) = "Boolean" Then If Source = False Then Exit Sub
For Each f In Source
'開啟檔案/活頁簿
With Workbooks.Open(f)
'對所有工作表
For i = 1 To ActiveWorkbook.Sheets.Count
'複製工作表到本活頁簿
.Sheets(i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'本活頁簿中該工作表
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'依E,F欄排序
.[A1].CurrentRegion.Sort Key1:=.[E:E], Order1:=xlAscending, _
Key2:=.[F:F], Order2:=xlAscending, _
Header:=xlYes
'刪除不要的欄
.Range("A:C,E:I,K:L,Q:Q").Delete Shift:=xlToLeft
End With
Next i
'關閉檔案
.Close
End With
Next f
End Sub

複製代碼

帖子: 25
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: windows 2007
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2013-1-22
最後登錄: 2014-4-29

7^#

發表於 2013-1-23 16:04 | 只看該作者

感謝stillfish00 這對我這菜鳥來說，看起來簡直是變魔術，感恩，是您的匯入方式比較合理，
.Range("A:C,E:I,K

,Q

").Delete Shift:=xlToLeft是直接選定欄位
最後一個問題是所謂"刪除特定攔位"可以是指定保留(section) (SC) (LANDUSE) (PUBNO) (OPTION) (METHOD) (MUPLAN) (DUPLAN) (ORG_FID)標題的一整個欄位，其他無論甚麼標題的欄位都刪掉的寫法嗎(用以確保批次時某一個檔的例外多一條無須保留的攔位)

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

8^#

發表於 2013-1-23 21:04 | 只看該作者

回復 7# billchenfantasy

Private Sub CommandButton1_Click()
Dim Source, f
Dim rng As Range
'可選擇多個檔案
Source = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx),*.xls;*.xlsx", _
MultiSelect:=True)
If TypeName(Source) = "Boolean" Then If Source = False Then Exit Sub
For Each f In Source
'開啟檔案/活頁簿
With Workbooks.Open(f)
'對所有工作表
For i = 1 To ActiveWorkbook.Sheets.Count
'複製工作表到本活頁簿
.Sheets(i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'本活頁簿中該工作表
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'依land_no_m, land_no_c欄排序
If Not IsError(Application.Match("land_no_m", .Rows(1), 0)) Then .[A1].CurrentRegion.Sort Key1:=.Columns(Application.Match("land_no_m", .Rows(1), 0)), Order1:=xlAscending, Header:=xlYes
If Not IsError(Application.Match("land_no_c", .Rows(1), 0)) Then .[A1].CurrentRegion.Sort Key1:=.Columns(Application.Match("land_no_c", .Rows(1), 0)), Order1:=xlAscending, Header:=xlYes
'找出不符合的欄
For j = 1 To .[A1].CurrentRegion.Columns.Count
If IsError(Application.Match(.Cells(1, j).Value, Array("section", "SC", "LANDUSE", "PUBNO", "OPTION", "METHOD", "MUPLAN", "DUPLAN", "ORG_FID"), 0)) Then
If rng Is Nothing Then Set rng = .Columns(j) Else Set rng = Union(rng, .Columns(j))
End If
Next j
'刪除
.Range(rng.Address).Delete shift:=xlToLeft
Set rng = Nothing
End With
Next i
'關閉檔案
.Close
End With
Next f
End Sub

複製代碼

帖子: 25
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: windows 2007
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2013-1-22
最後登錄: 2014-4-29

9^#

發表於 2013-1-24 09:29 | 只看該作者

感激~註解詳細~感覺上了一課@@謝謝您的解答

帖子: 25
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: windows 2007
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2013-1-22
最後登錄: 2014-4-29

10^#

發表於 2013-1-25 12:03 | 只看該作者

遇到問題了@@如果需要以land_no_m為KEY1與land_no_c為KEY2去做排序以下排序的程序該如何修改ㄋ

If Not IsError(Application.Match("land_no_m", .Rows(1), 0)) Then .[A1].CurrentRegion.Sort Key1:=.Columns(Application.Match("land_no_m", .Rows(1), 0)), Order1:=xlAscending, Header:=xlYes

If Not IsError(Application.Match("land_no_c", .Rows(1), 0)) Then .[A1].CurrentRegion.Sort Key1:=.Columns(Application.Match("land_no_c", .Rows(1), 0)), Order1:=xlAscending, Header:=xlYes