2016-11-12 12 views
0

Excelの表があります。シートに「CR」の値を持つすべての行(ヘッダー行を除く)を使用します(可能な場合は数式を除いて))は、ファイルが保存される前にまず列B(name = TEAM)、次にC(name = BUILDING)、最後にD(name = DATE_MAJ)でソートされます。複数の列でVBA Excelソート

私はVBAの絶対的なノブですので、私はフォアの左右にあるものを試して、自分のニーズに合わせて修正しています。周りの検索から、私はエクセルVBAオブジェクトのワークブック」でこのコードを試してみましたが、それはエラーを与える:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
'Setup column names 
Col1name = "SECTION" 
Col2name = "BATIMENT" 
Col3name = "DATE_MAJ" 

'Find cols 
For Each cell In Range("A1:" & Range("A1").End(xlToRight).Address) 
    If cell.Value = Col1name Then 
     Col1 = cell.Column 
    End If 
    If cell.Value = Col2name Then 
     Col2 = cell.Column 
    End If 
    If cell.Value = Col3name Then 
     Col3 = cell.Column 
    End If 

Next 

'Below two line:- if they are blank e.g. column not found it will error so a small bit of error handling 
If Col1 = "" Then Exit Sub 
If Col2 = "" Then Exit Sub 
If Col3 = "" Then Exit Sub 

'Find last row - dynamic part 
lastrow = ActiveSheet.Range("A100000").End(xlUp).Row 

'Convert col numer to name 
Col1 = Split(Cells(1, Col1).Address(True, False), "$") 
Col2 = Split(Cells(1, Col2).Address(True, False), "$") 
Col3 = Split(Cells(1, Col3).Address(True, False), "$") 

'Sort 
With ActiveSheet.Sort 
    .SortFields.Clear 
    .SortFields.Add Key:=Range(Col1(0) & "2:" & Col1(0) & lastrow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    .SortFields.Add Key:=Range(Col2(0) & "2:" & Col2(0) & lastrow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    .SortFields.Add Key:=Range(Col3(0) & "2:" & Col3(0) & lastrow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 

    .SetRange Range("A1:K" & lastrow) 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
End Sub 

私は、コードの権利を得ることに任意の助けに感謝するだろう。以下は、Excelファイルへのリンクです(上記のコードは動作しませんでした)。代わりにWorksheetオブジェクトの同名メソッドの

Dropbox link to Excel file

+0

どのようなエラーが発生しますか?どのラインがそれを投げているのですか?さらに、リンクされた例には、 "BATIMENT"と "DATE_MAJ"のいずれの名前も付けられていない列ヘッダーはありません – user3598756

+0

列CとDの列名は "BATIMENT"と "DATE_MAJ"です。彼らのヘッダーは確かに "BUILDING"と "DATE UPDATE"です。それは重要ですか? – Antoon

+0

エラーは、コンパイルエラー:変数が定義されていません 'と' Col1name 'がVBAコードで選択されています。 – Antoon

答えて

2

あなただけがRangeオブジェクトのSort()方法を使用することをお勧めします3つのソート列を持っているので、

は、さらにあなたはできるリンクExcelファイルごとに列ヘッダを想定し試してみてください:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Dim col1 As Range, col2 As Range, col3 As Range 
    Dim lastRow As Long 

    'Setup column names 
    Const col1Name As String = "SECTION" 
    Const col2Name As String = "BUILDING" '"BATIMENT" 
    Const col3Name As String = "DATE UPDATE" '"DATE_MAJ" 

    With Worksheets("CR") '<--| reference your worksheet 
     'Find last row - dynamic part 
     lastRow = .Cells(.Rows.Count, 1).End(xlUp).row ' <--|find its column "A" last not empty row index 
     'Find cols 
     With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) '<--|reference its row 1 cells from column 1 to last not empty one and search for sorting columns whose header matches above set column names 
      If Not TryGetColumnIndex(.Cells, col1Name, col1) Then Exit Sub '<--| if 1st sorting column not found then exit sub 
      If Not TryGetColumnIndex(.Cells, col2Name, col2) Then Exit Sub '<--| if 2nd sorting column not found then exit sub 
      If Not TryGetColumnIndex(.Cells, col3Name, col3) Then Exit Sub '<--| if 3rd sorting column not found then exit sub 
      .Resize(lastRow).Sort _ 
          key1:=col1, order1:=xlAscending, DataOption1:=xlSortNormal, _ 
          key2:=col2, order2:=xlAscending, DataOption2:=xlSortNormal, _ 
          key3:=col3, order3:=xlAscending, DataOption3:=xlSortNormal, _ 
          Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin 
     End With 
    End With 
End Sub 

Function TryGetColumnIndex(rng As Range, colName As String, col As Range) As Boolean 
    Set col = rng.Find(What:=colName, LookIn:=xlValues, LookAt:=xlWhole) 
    TryGetColumnIndex = Not col Is Nothing 
End Function 
+0

ありがとうございますが、そのコードは、次のとおりです。実行時エラー '438':オブジェクトは、このプロパティまたはメソッドをサポートしていません。 'debug'をクリックすると、次の行が強調表示されます。lastRow = .Cells(.Rows.Count、1).End(xlUp).rowrow '< - |列 "A"を最後に空にしていない行インデックス – Antoon

+0

which error ?どのラインがそれを投げているのですか? – user3598756

+0

オブジェクト 'ThisWorkbook'にコードを貼り付けました。私はそれが正しいと思いますか? – Antoon