Board logo

標題: [發問] 排序後刪除特定攔位 [打印本頁]
作者: billchenfantasy    時間: 2013-1-22 16:06     標題: 排序後刪除特定攔位

[attach]14040[/attach]
呈上資料頁面，請問如果我要先以land_no_m和land_no_c兩攔為準做排序之後保留以下這九個欄位其他刪除該怎麼撰寫VBA呢~感謝
(section) (SC) (LANDUSE)  (PUBNO)        (OPTION)        (METHOD)        (MUPLAN)        (DUPLAN)        (ORG_FID)
[attach]14041[/attach]
作者: stillfish00    時間: 2013-1-23 09:28

回復 1# billchenfantasy
依你敘述的需求應該用一般Excel操作就可達成:
先將不必要的欄刪除 , 再到  資料>排序(excel 2010)  設定即可
作者: billchenfantasy    時間: 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
-------------------------------------------------------------
其實我是想指定刪除上述特定標題的欄位
作者: stillfish00    時間: 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
作者: billchenfantasy    時間: 2013-1-23 12:20

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

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

你要的批次處理是這樣嗎? (可選多個檔案)
  1. Private Sub CommandButton1_Click()
  2. Dim Source, f

  4. '可選擇多個檔案
  5. Source = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx),*.xls;*.xlsx", _
  6.                                     MultiSelect:=True)
  7. If TypeName(Source) = "Boolean" Then If Source = False Then Exit Sub

  9. For Each f In Source
  10. '開啟檔案/活頁簿
  11. With Workbooks.Open(f)
  12.     '對所有工作表
  13.     For i = 1 To ActiveWorkbook.Sheets.Count
  14.         '複製工作表到本活頁簿
  15.         .Sheets(i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  16.         '本活頁簿中該工作表
  17.         With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  18.            '依E,F欄排序
  19.            .[A1].CurrentRegion.Sort Key1:=.[E:E], Order1:=xlAscending, _
  20.                                     Key2:=.[F:F], Order2:=xlAscending, _
  21.                                     Header:=xlYes
  22.            '刪除不要的欄
  23.            .Range("A:C,E:I,K:L,Q:Q").Delete Shift:=xlToLeft
  24.         End With
  25.     Next i
  26.     '關閉檔案
  27.     .Close
  28. End With
  29. Next f
  30. End Sub
複製代碼
作者: billchenfantasy    時間: 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)標題的一整個欄位，其他無論甚麼標題的欄位都刪掉的寫法嗎(用以確保批次時某一個檔的例外多一條無須保留的攔位)
作者: stillfish00    時間: 2013-1-23 21:04

回復 7# billchenfantasy
  1. Private Sub CommandButton1_Click()
  2. Dim Source, f
  3. Dim rng As Range

  5. '可選擇多個檔案
  6. Source = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx),*.xls;*.xlsx", _
  7.                                     MultiSelect:=True)
  8. If TypeName(Source) = "Boolean" Then If Source = False Then Exit Sub

  10. For Each f In Source
  11. '開啟檔案/活頁簿
  12. With Workbooks.Open(f)
  13.     '對所有工作表
  14.     For i = 1 To ActiveWorkbook.Sheets.Count
  15.         '複製工作表到本活頁簿
  16.         .Sheets(i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  17.         '本活頁簿中該工作表
  18.         With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  19.            '依land_no_m, land_no_c欄排序
  20.             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
  21.             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
  22.             
  23.             '找出不符合的欄
  24.             For j = 1 To .[A1].CurrentRegion.Columns.Count
  25.                 If IsError(Application.Match(.Cells(1, j).Value, Array("section", "SC", "LANDUSE", "PUBNO", "OPTION", "METHOD", "MUPLAN", "DUPLAN", "ORG_FID"), 0)) Then
  26.                     If rng Is Nothing Then Set rng = .Columns(j) Else Set rng = Union(rng, .Columns(j))
  27.                 End If
  28.             Next j
  29.             '刪除
  30.             .Range(rng.Address).Delete shift:=xlToLeft
  31.             Set rng = Nothing
  32.         End With
  33.     Next i
  34.     '關閉檔案
  35.     .Close
  36. End With
  37. Next f
  38. End Sub
複製代碼
作者: billchenfantasy    時間: 2013-1-24 09:29

感激~註解詳細~感覺上了一課@@謝謝您的解答
作者: billchenfantasy    時間: 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
作者: stillfish00    時間: 2013-1-25 13:47

回復 10# billchenfantasy
land_no_m, land_no_c 每張表都有嗎?
  1.     If Not (IsError(Application.Match("land_no_m", .Rows(1), 0)) Or _
  2.             IsError(Application.Match("land_no_c", .Rows(1), 0))) Then
  3.         .[A1].CurrentRegion.Sort Key1:=.Columns(Application.Match("land_no_m", .Rows(1), 0)), _
  4.                                     Order1:=xlAscending, _
  5.                                     Key2:=.Columns(Application.Match("land_no_c", .Rows(1), 0)), _
  6.                                     Order2:=xlAscending, _
  7.                                     Header:=xlYes
  8.     Else
  9.         MsgBox .Sheets(i).Name & " : Sorting field not found."
  10.     End If
複製代碼
作者: billchenfantasy    時間: 2013-1-25 14:10

@@是的每張欄位格式都是一樣的，所以land_no_m, land_no_c 每張表都有，只有少數才有多一行的狀況才會想說指定欄位，感謝您的再度協助
作者: stillfish00    時間: 2013-1-25 14:15

回復 12# billchenfantasy
恩 試了一下  #10 的兩行順序調換
結果應該跟 #11 一樣



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)