kevinya

CollapseGroup收合群組,ExpandGroup打開群組：

Sub CollapseGroup()
    ActiveSheet.Outline.ShowLevels ColumnLevels:=1
End Sub


Sub ExpandGroup()
    ActiveSheet.Outline.ShowLevels ColumnLevels:=2
End Sub

設定某欄位小數點5位：

Sub aaa()
    Dim sheetName As String
    sheetName = "ExportShipPlan"
    

    設定小數點幾位 sheetName, "Unit Price", 5
    
End Sub


Sub 設定小數點幾位(sheetName As String, columnName As String, numberOfDigits As Integer)
    '設定欄位格式小數點幾位
    Dim FoundFloatingNumber As Range
    'Unit Price小數點五位
    Set FoundFloatingNumber = Sheets(sheetName).Rows("1:1").Find(columnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    '把這個欄位的value重新給一次，確保萬一不會出錯
    'Sheets(sheetName).Columns(FoundFloatingNumber.Column).Select
    'Selection.Value = Selection.Value
    Dim numberFormat As String
    numberFormat = "0."
    numberFormat = numberFormat & Replace(Space(numberOfDigits), " ", "0")
    Sheets(sheetName).Columns(FoundFloatingNumber.Column).numberFormat = numberFormat

End Sub

執行前：
 

執行後：
 

設定某欄位千分號comma：

Sub aaa()
    Dim sheetName As String
    sheetName = "ExportShipPlan"
    

    設定千分號comma sheetName, "Ordered Qty"
    
End Sub


Sub 設定千分號comma(sheetName As String, columnName As String)
   
    Dim FoundNumber As Range
    'Unit Price小數點五位
    Set FoundNumber = Sheets(sheetName).Rows("1:1").Find(columnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    '把這個欄位的value重新給一次，確保萬一不會出錯
    Sheets(sheetName).Columns(FoundNumber.Column).Select
    Selection.Value = Selection.Value
    '千分號+小數點的話，格式設定成這樣
    Sheets(sheetName).Columns(FoundNumber.Column).numberFormat = "#,##0.00"
    '千分號且不要小數點話，格式設定成這樣
    'Sheets(sheetName).Columns(FoundNumber.Column).numberFormat = "#,##0"

End Sub

執行前：
 

執行後：
 

刪除空白資料列: 經測試可刪除一百萬筆也沒問題

Option Explicit

Sub DeleteBlankRowTest()
    Dim wkbSource As Workbook

    Dim strSourceFileToOpen As String
    strSourceFileToOpen = ""
    '透過dialog視窗取得檔案名稱
    strSourceFileToOpen = Application.GetOpenFilename _
    (Title:="請選擇 要排序資料 的檔案", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    
    If strSourceFileToOpen = "False" Then
        MsgBox "選取 要排序資料 的檔案失敗！.", vbExclamation, "Sorry!"
        Exit Sub
    Else
        Set wkbSource = Workbooks.Open(strSourceFileToOpen)
        wkbSource.Activate
    End If
    Dim intActiveSheetNoInSourceFile As Integer
    intActiveSheetNoInSourceFile = 1
    Dim wsSource As Worksheet
    Set wsSource = wkbSource.Sheets(intActiveSheetNoInSourceFile)

    '關掉畫面上的資料的更新：
    Application.ScreenUpdating = False
    
    '刪除空白的row, 避免結果有十幾萬個row
    wkbSource.Activate
    wsSource.Activate
    DeleteBlankRowsUnderData wsSource
    DeleteBlankRowsInData wsSource
    
    '初始化selection，可作可不做
    Cells(2, 1).Select

    '開啟畫面上的資料的更新
    Application.ScreenUpdating = True

    MsgBox "作業順利完成!"
End Sub

'刪除資料 下面 的空白的列
Sub DeleteBlankRowsUnderData(ws As Worksheet)
    Dim longCellLastRow As Long
    '填入最不會缺漏資料的欄位，這邊是Sales Price
    longCellLastRow = GetLastRowByColumnName(ws, "Sales Price")
    Dim r As Range, rows As Long, i As Long
    Set r = ActiveSheet.UsedRange
    rows = r.rows.Count
    
    For i = rows To (longCellLastRow + 10) Step (-1)
        If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
    Next

End Sub

'刪除資料 裡面 的空白的列
Sub DeleteBlankRowsInData(ws As Worksheet)
    
    Dim r As Range, rows As Long, i As Long
    Set r = ActiveSheet.UsedRange
    rows = r.rows.Count
    
    For i = rows To 2 Step (-1)
        If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
    Next

End Sub

'取得最後一列lastrow
Function GetLastRowByRange(ws As Worksheet, rangeColumn As Range) As Long
    Dim longLastRow As Long
    longLastRow = ws.Cells(rows.Count, rangeColumn.Column).End(xlUp).Row
    GetLastRowByRange = longLastRow
End Function

'取得最後一列lastrow
Function GetLastRowByColumnName(ws As Worksheet, strColumnName As String) As Long
    Dim longLastRow As Long
    longLastRow = ws.Cells(rows.Count, FindColumn(ws, strColumnName).Column).End(xlUp).Row
    GetLastRowByColumnName = longLastRow
End Function

'尋找某個欄位
Function FindColumn(ws As Worksheet, strColumnName As String) As Range
    Dim FoundColumn As Range
              
    Set FindColumn = ws.rows("1:1").Find(strColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

完整範例下載:
https://drive.google.com/drive/folders/1IUOMw4zg8U1_W8jZpZb3Rt8xKZg0TDLr?usp=sharing


刪除某欄位

Sub DeleteColumn()
    '開啟來源檔案
    Dim wkbSource As Workbook

    Dim strSourceFileToOpen As String
    strSourceFileToOpen = ""
    '透過dialog視窗取得檔案名稱
    strSourceFileToOpen = Application.GetOpenFilename _
    (Title:="請選擇 MPS BILLING 的檔案", _
    FileFilter:="Excel Files *.xls* (*.xls*),")
    
    If strSourceFileToOpen = "False" Then
        MsgBox "選取 MPS BILLING 的檔案失敗！.", vbExclamation, "Sorry!"
        Exit Sub
    Else
        Set wkbSource = Workbooks.Open(strSourceFileToOpen)
        wkbSource.Activate
    End If
    Dim intActiveSheetNoInSourceFile As Integer
    intActiveSheetNoInSourceFile = 1
    Dim wsSource As Worksheet
    Set wsSource = wkbSource.Sheets(intActiveSheetNoInSourceFile)
    'source檔案找到 對照值 的欄位
    '關掉畫面上的資料的更新：
    '執行巨集之前，先把畫面更新關掉，可以比較快速跑完巨集，不過資料量不大
    '的時候，也沒必要就是了，記得程式碼的最後要把他再打開
    Application.ScreenUpdating = False
    
    '刪除 productno 欄位
    Columns(FindColumn(wsSource, "productno").Column).EntireColumn.Delete
    Application.ScreenUpdating = True
    
    MsgBox "刪除欄位成功！"
    
End Sub

'尋找某個欄位
Function FindColumn(ws As Worksheet, strColumnName As String) As Range
    Dim FoundColumn As Range
          
    'Set FoundColumn = ws.Rows("1:1").Find(strColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

    Set FindColumn = ws.Rows("1:1").Find(strColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

完整範例下載：
https://drive.google.com/drive/folders/1MRB5WXLb5PmigEB8aj8ENhtM868U2c7v?usp=sharing





參考資料：
Using VBA Macro to format a column into Comma Style - www.mrexcel.com
https://www.mrexcel.com/forum/excel-questions/249185-using-vba-macro-format-column-into-comma-style.html
Use of .NumberFormat to Format Decimal Places in Excel VBA
https://stackoverflow.com/questions/36878519/use-of-numberformat-to-format-decimal-places-in-excel-vba
Excel VBA: Expand or Collapse All Groups - JC Speaking
http://jamiche.blogspot.com/2014/03/excel-vba-expand-or-collapse-all-groups.html