|
那位大哥帮忙修改一下附件代码,数据居多的时候运行速度变慢,谢谢!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim x As Integer
Dim Rng As Range
Set Rng = Range("K5:K" & Range("K1048576").End(xlUp).Row)
For Each cell In Rng
str = Replace(Replace(Replace(cell.Text, "---", "-"), "--", "-"), " ", "")
C = 13
r = cell.Row
For Each e In Split(str, "*")
Cells(r, C) = e
C = C + 1
If C > 19 Then Exit For '〔假设你控制到五列止〕
Next
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' 检查变更的单元格是否为A列
If Not Intersect(Target, Range("P:P")) Is Nothing Then
' 计算A列的和,并将结果显示在B1单元格
Range("T5").Value = Application.WorksheetFunction.Sum(Range("P:P"))
End If
If Not Intersect(Target, Range("G:G")) Is Nothing Then
' 计算A列的和,并将结果显示在B1单元格
Range("U5").Value = Application.WorksheetFunction.Sum(Range("G:G"))
End If
If (Target.Column = 7 Or Target.Column = 16) And Target.Row > 4 Then
r = Target.Row
Range("h" & r) = Range("g" & r) / Range("p" & r)
End If
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("K:K"), Target)
xOffsetColumn = -10
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Date
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
Dim i As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("K:K"), Target)
xOffsetColumn = -9
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Time
Rng.Offset(0, xOffsetColumn).NumberFormat = "hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
|
|