Excel VBAの日付による自動ソート

Question

マクロの作成やVBAの使用には新しく、うまくいけば簡単に修正することができます。私は現在、Excelのプロジェクトで、マクロが添付されたボタンをクリックすると、列Lの値（1aまたは1b）に基づいて、1つのマスターシートから2つのマスターシートにデータをコピーして貼り付けることができます私がこれまでに持っていたマクロは、copy/paste要素でうまくいきますが、コピーしたデータを貼り付けたときの日付と時刻（列J）で古いものから最新のものに自動ソートすることが大好きです宛先シートに挿入します。日付/時刻の形式は、MM/DD/YY HH：MM AMまたはPMです。

Sub EGS_CVS_Sorting() 
Dim lr As Long, lr2 As Long, r As Long 

    lr = Sheets("template").Cells(Rows.Count, "L").End(xlUp).Row 

    For r = lr To 2 Step -1 

     Select Case Sheets("template").Range("L" & r).Value 
      Case Is = "1a" 
       lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row 
       Sheets("template").Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1) 

      Case Is = "1b" 
       lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row 
       Sheets("template").Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1) 
     End Select 

    Next r 

End Sub 

ありがとうございます！

Answer 1

Google for vba excel sortで541000件の検索結果のどれもあなたの興味を引くことはありませんでしたか？ チェックこれは正しい方向にあなたをしてくださいリードしたが、ヘッダーなどについて確認し、ソートしたいデータの範囲を調整する場合：いくつかのタスクあなたの避難所を実行するマクロを記述するための

Sub EGS_CVS_Sorting() 
Dim lr As Long, lr2 As Long, r As Long 

    lr = Sheets("template").Cells(Rows.Count, "L").End(xlUp).Row 

    For r = lr To 2 Step -1 

     Select Case Sheets("template").Range("L" & r).Value 
      Case Is = "1a" 
       lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row 
       Sheets("template").Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1) 

      Case Is = "1b" 
       lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row 
       Sheets("template").Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1) 
     End Select 

    Next r 
    With Sheets("EGS lines") 
     lr = .Cells(Rows.Count, "L").End(xlUp).Row 
     Range("A1:L" & lastrow).Sort key1:=Range("J1:J" & lr), _ 
      order1:=xlAscending, Header:=xlYes 
    End With 
    With Sheets("CVS lines") 
     lr = .Cells(Rows.Count, "L").End(xlUp).Row 
     Range("A1:L" & lastrow).Sort key1:=Range("J1:J" & lr), _ 
      order1:=xlAscending, Header:=xlYes 
    End With 
End Sub 

Answer 2

良い出発点前にコード化したのは、あなたがやりたいタスクを実行しているマクロを単に記録することです。したがって、J列に日付があるサンプルデータセットから始めれば、マクロの記録を開始し、列Jでデータを並べ替え、記録を停止してコードを確認します。

Sub Sorter() 
' 
' Sort Macro 
' 

' 
    Range("J1").Select 
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:= _ 
     Range("J1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortNormal 
    With ActiveWorkbook.Worksheets("All Active Clients").Sort 
     .SetRange Range("F2:J23") 
     .Header = xlNo 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End Sub 

これは私がセルJ1を選択したことを手動でコード化して、次にソート機能が実行されるステップを示しています。これから、私は実際にやりたいことを絞ることができます。例えば、選択J1は不要ですが、私は私のようなものまで、コードをトリミングすることができますなど.sortmethod、心配する必要はありません、以下：

Sub Sorter() 
' 
' Sort Macro 
' 

' 
    Const csDateSt As String = "J1" 

    Dim shtSort As Worksheet 
    Dim rngSort As Range 

    Set shtSort = Sheets("Sheet1") 
    Set rngSort = shtSort.UsedRange 

    With shtSort.Sort 
     .SortFields.Clear 
     .SortFields.Add Key:= _ 
         Range(csDateSt), _ 
         SortOn:=xlSortOnValues, _ 
         Order:=xlAscending 
     .SetRange rngSort 
     .Header = xlNo 
     .Apply 
    End With 
End Sub 

私が行っているすべてが記録されたコードを再編成でありますいくつかのハードコードされた値を定数と変数に変更し、すべてをWithブロックに入れました。私はこれをロードマップとして使用して、必要な場所に同じ種類の構造を配置することができます。

あなたは、このように、でも、別のサブとして、あなたのソート処理を維持し、必要なときだけそれを呼び出すと、データがどこにそれを伝えるために、引数を渡すことができます：

Sub Sorter(ByVal shtSort As Worksheet, ByVal rngSort As Range, ByVal strKey As String) 
    With shtSort.Sort 
     .SortFields.Clear 
     .SortFields.Add Key:= _ 
         Range(strKey), _ 
         SortOn:=xlSortOnValues, _ 
         Order:=xlAscending 
     .SetRange rngSort 
     .Header = xlNo 
     .Apply 
    End With 
End Sub 

を次に、あなたのループの中であなたは言うでしょう

Select Case Sheets("template").Range("L" & r).Value 
     Case Is = "1a" 
      lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row 
      Sheets("template").Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1) 

     Case Is = "1b" 
      lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row 
      Sheets("template").Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1) 
    End Select 

Call Sorter(Sheets("EGS Lines"),Sheets("EGS Lines").range("A1").currentregion, "J1") 
Call Sorter(Sheets("CVS Lines"),Sheets("CVS Lines").range("A1").currentregion, "J1")