Question

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

此外，格式将与上一行类似。例如，第二列是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函数并从change-event调用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

罗

自动排序和格式化和Excel

2 个答案: