vba 自动排序和格式化以及 Excel

Auto sort and format and Excel

提问by Mike

I have a table of clients in Excel, and I want to be able to add new client into the last row of the table and excel will sort the table automatically so that the client's name will be sorted in alphabetical order.

我在 Excel 中有一个客户表格，我希望能够将新客户添加到表格的最后一行，Excel 会自动对表格进行排序，以便客户名称按字母顺序排序。

Also, that the format will be similar to the previous line. for example, the second column is DOB, so I want the format to be the same as the previous row MM/DD/YYYY

此外，格式将类似于前一行。比如第二列是DOB，所以我希望格式和上一行MM/DD/YYYY一样

Thanks

谢谢

回答by nutsch

Put the attached code in your worksheet module and it will sort your column A automatically.

将附加的代码放在您的工作表模块中，它会自动对 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

回答by Avan

Here's a piece of VBA that would auto-add your table as soon as the first cell on the last row gets typed in. You would have to provide IsChangeInLastLineOfStrRange function and call AddEmptyRowWhenFull from the change-event. It might need tweaking since I removed some code from it. The original has a recursion timer to prevent ... well ... recursion.

这是一段 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

Arjen.

阿让。