自动sorting和格式和Excel

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

另外，格式与上一行相似。 例如，第二列是DOB，所以我希望格式与前一行MM / DD / YYYY相同

谢谢

Answer 1

把附加的代码放在工作表模块中，它会自动对列A进行sorting。

 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，当最后一行的第一个单元格被input时，它会自动添加你的表格。你必须提供IsChangeInLastLineOfStrRange函数，并且从change-event中调用AddEmptyRowWhenFull。 它可能需要调整，因为我从中删除了一些代码。 原来有一个recursion计时器来防止…以及recursion。

 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 

罗。