vba - 自動並べ替えと書式設定と Excel

Question

Excel にクライアントのテーブルがあり、テーブルの最後の行に新しいクライアントを追加できるようにしたいと考えています。Excel はテーブルを自動的に並べ替えて、クライアントの名前がアルファベット順に並べ替えられるようにします。

また、フォーマットは前の行と同様になります。たとえば、2列目はDOBなので、前の行のMM/DD/YYYYと同じ形式にしたい

ありがとう

Answer 1

添付のコードをワークシート モジュールに配置すると、列 A が自動的に並べ替えられます。

Private Sub Worksheet_Change(ByVal Target As Range)
'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

If Not Intersect(Target, Columns(1)) Is Nothing Then

    With ActiveSheet.Sort
        .SetRange Range("A1:X" & Cells(Rows.Count, 1).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Columns("B").NumberFormat = "MM/DD/YYYY"

End If

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

Answer 2

これは、最後の行の最初のセルが入力されるとすぐにテーブルを自動追加する VBA の一部です。IsChangeInLastLineOfStrRange 関数を提供し、変更イベントから AddEmptyRowWhenFull を呼び出す必要があります。一部のコードを削除したため、微調整が必​​要になる場合があります。オリジナルには、防止するための再帰タイマーがあります...まあ...再帰。

Public Sub AddEmptyRowWhenFull(SheetName As String, Area As String, Target As Range)
    Dim rngDatabase As Range

    With Sheets(SheetName)
        If IsChangeInLastLineOfStrRange(SheetName, Area, Target) _
        And Target.Value <> "" Then
            Set rngDatabase = .Range(Area)
            AddEmptyRow rngDatabase, rngDatabase.Rows.Count
        End If
    End With
End Sub


Public Sub AddEmptyRow(Database As Range, RowPosition As Long, Optional ClearLine As Boolean = True)
    Dim bScreenupdate, iCalculation As Integer
    Dim colnum As Long, markrow As Long
    Dim bUpdate As Boolean

    bScreenupdate = Application.ScreenUpdating
    iCalculation = Application.Calculation

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Database
         If RowPosition < .Rows.Count Then
            .Rows(RowPosition - 0).Copy                     'Insert in and after data
        .Rows(RowPosition + 1).Insert shift:=xlDown
         Else
            .Rows(RowPosition - 0).Copy                     'Add line at end by inserting before last line
            .Rows(RowPosition - 0).Insert shift:=xlDown     ' to prevent cell formatting below it to be copied too
             RowPosition = RowPosition + 1                  'Clear last of the copies
         End If

         If ClearLine = False Then                          'Move cursor down
            ActiveSheet.Cells(ActiveCell.row + 1, ActiveCell.column).Activate
         Else
            For colnum = 1 To .Columns.Count                'Preserve formula's
                If Not .Rows(RowPosition).Cells(1, colnum).HasFormula Then 'changed
                       .Rows(RowPosition).Cells(1, colnum).ClearContents
                End If
            Next colnum
         End If

         'Fix rowheight if we shift into other heights

         .Rows(RowPosition + 1).RowHeight = .Rows(RowPosition + 0).RowHeight
    End With

    If bScreenupdate = True Then Application.ScreenUpdating = True
    If Not iCalculation = xlCalculationManual Then Application.Calculation = iCalculation
End Sub

アリエン。