返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 2013-1-23 09:28 | 顯示全部帖子
回復 1# billchenfantasy
依你敘述的需求應該用一般Excel操作就可達成:
先將不必要的欄刪除 , 再到  資料>排序(excel 2010)  設定即可

TOP

stillfish00

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

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2013-1-25 14:15 | 顯示全部帖子
回復 12# billchenfantasy
恩 試了一下  #10 的兩行順序調換
結果應該跟 #11 一樣

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題