也许我太挑剔了,但是我的宏需要大约1秒才能在强大的笔记本电脑中运行(数据很少)。但它将在平均 - 慢性能PC上运行。
有没有办法优化此代码?你认为Select Case
是否会减慢执行速度?如果是这样,我该如何改进呢?
很抱歉代码扩展。
谢谢。
Private Sub crear_Click()
Dim ctrl As Control, ctrl2 As Control, aler As Variant, ws As Worksheet, ws2 As Worksheet, ultimafila As Double, ultimaFila2 As Double, i As Integer, pPage As MSForms.Page, N As Double, selectedItems As String, valorProbabilidad As Integer, valorImpacto As Integer, valorMagnitud As Integer, resta As Long, ultimaFila3 As Long, j As Long, ultimaFila4 As Long, k As Double, l As Double
Set ws = Worksheets("Valoración"): Set ws2 = Worksheets("lista_riesgos")
ultimafila = ws.ListObjects("Riesgos").Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ultimaFila2 = ws2.ListObjects("consolidadoRiesgos").Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ultimaFila3 = ws2.ListObjects("consolidadoRiesgos").Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
ultimaFila4 = ws2.ListObjects("Riesgo").Range.Columns(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
resta = 0.5
With Me
For Each ctrl In .Controls
If Left(ctrl.Name, 5) = "texto" Then
If Trim(ctrl.Value & vbNullString) = vbNullString Then
aler = Replace(ctrl.Name, "texto", "alerta")
.Controls(aler).Visible = True
End If
ElseIf Left(ctrl.Name, 5) = "lista" Then
For N = 0 To listaObjetivos.ListCount - 1
If listaObjetivos.Selected(N) Then GoTo algoSeleccionado
Next N
aler = Replace(ctrl.Name, "lista", "alerta")
.Controls(aler).Visible = True
GoTo salir
algoSeleccionado:
aler = Replace(ctrl.Name, "lista", "alerta")
.Controls(aler).Visible = False
GoTo continuar
salir:
End If
Next ctrl
Exit Sub
End With
continuar:
Select Case Me.textoFrecuencia
Case "Casi seguro"
valorProbabilidad = 5
Case "Probable"
valorProbabilidad = 4
Case "Posible"
valorProbabilidad = 3
Case "Improbable"
valorProbabilidad = 2
Case "Raro"
valorProbabilidad = 1
End Select
Select Case Me.textoImpacto
Case "Catastrófico"
valorImpacto = 5
Case "Mayor"
valorImpacto = 4
Case "Moderado"
valorImpacto = 3
Case "Menor"
valorImpacto = 2
Case "Insignificante"
valorImpacto = 1
End Select
valorMagnitud = valorProbabilidad * valorImpacto
With ws
.Unprotect Password:="pAtRiCiA"
For Each ctrl In Me.Controls
If Left(ctrl.Name, 5) = "texto" Then
.Cells(ultimafila, ctrl.TabIndex) = ctrl.Value
End If
Next ctrl
For i = 0 To listaObjetivos.ListCount - 1
If listaObjetivos.Selected(i) = True Then
ws.Cells(ultimafila, (i) + 6) = "X"
'selectedItems = selectedItems & listaObjetivos.List(i) & (i) & vbNewLine
End If
Next i
Select Case valorMagnitud
Case Is >= 15
.Cells(ultimafila, 25) = "Extremo"
Case 8 To 14
.Cells(ultimafila, 25) = "Alto"
Case 4 To 7
.Cells(ultimafila, 25) = "Medio"
Case 1 To 3
.Cells(ultimafila, 25) = "Aceptable"
End Select
.Rows(ultimafila).AutoFit
.Rows(ultimafila).RowHeight = .Cells(ultimafila, 1).Height + 12
.Protect Password:="pAtRiCiA", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
With ws2
.Unprotect Password:="pAtRiCiA"
.Cells(ultimaFila2, 1) = (valorProbabilidad * valorProbabilidad * valorProbabilidad) + valorImpacto
.Cells(ultimaFila2, 2) = Me.textoCodigo
.ListObjects("Riesgo").DataBodyRange.Columns(1).ClearContents
For k = 1 To ultimaFila3
Select Case .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 1).Value
Case 2
If .ListObjects("Riesgo").DataBodyRange.Cells(1, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(1, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(1, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(1, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 3
If .ListObjects("Riesgo").DataBodyRange.Cells(2, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(2, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(2, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(2, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 4
If .ListObjects("Riesgo").DataBodyRange.Cells(3, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(3, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(3, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(3, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 5
If .ListObjects("Riesgo").DataBodyRange.Cells(4, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(4, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(4, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(4, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 6
If .ListObjects("Riesgo").DataBodyRange.Cells(5, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(5, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(5, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(5, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 9
If .ListObjects("Riesgo").DataBodyRange.Cells(6, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(6, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(6, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(6, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 10
If .ListObjects("Riesgo").DataBodyRange.Cells(7, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(7, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(7, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(7, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 11
If .ListObjects("Riesgo").DataBodyRange.Cells(8, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(8, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(8, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(8, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 12
If .ListObjects("Riesgo").DataBodyRange.Cells(9, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(9, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(9, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(9, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 13
If .ListObjects("Riesgo").DataBodyRange.Cells(10, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(10, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(10, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(10, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 28
If .ListObjects("Riesgo").DataBodyRange.Cells(11, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(11, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(11, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(11, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 29
If .ListObjects("Riesgo").DataBodyRange.Cells(12, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(12, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(12, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(12, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 30
If .ListObjects("Riesgo").DataBodyRange.Cells(13, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(13, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(13, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(13, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 31
If .ListObjects("Riesgo").DataBodyRange.Cells(14, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(14, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(14, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(14, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 32
If .ListObjects("Riesgo").DataBodyRange.Cells(15, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(15, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(15, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(15, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 65
If .ListObjects("Riesgo").DataBodyRange.Cells(16, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(16, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(16, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(16, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 66
If .ListObjects("Riesgo").DataBodyRange.Cells(17, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(17, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(17, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(17, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 67
If .ListObjects("Riesgo").DataBodyRange.Cells(18, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(18, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(18, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(18, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 68
If .ListObjects("Riesgo").DataBodyRange.Cells(19, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(19, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(19, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(19, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 69
If .ListObjects("Riesgo").DataBodyRange.Cells(20, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(20, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(20, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(20, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 126
If .ListObjects("Riesgo").DataBodyRange.Cells(21, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(21, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(21, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(21, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 127
If .ListObjects("Riesgo").DataBodyRange.Cells(22, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(22, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(22, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(22, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 128
If .ListObjects("Riesgo").DataBodyRange.Cells(23, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(23, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(23, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(23, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 129
If .ListObjects("Riesgo").DataBodyRange.Cells(24, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(24, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(24, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(24, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
Case 130
If .ListObjects("Riesgo").DataBodyRange.Cells(25, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(25, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(25, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(25, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(k + 1, 2)
End If
End Select
Next k
.Protect Password:="pAtRiCiA", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
For j = 0 To listaObjetivos.ListCount - 1
listaObjetivos.Selected(j) = False
Next
Me.textoCodigo = Null
Me.textoTipo = Null
Me.textoResponsable = Null
Me.textoDescripcion = Null
Me.textoDetalle = Null
Me.textoControles = Null
Me.textoFrecuencia = Null
Me.textoEscala = Null
Me.textoImpacto = Null
End Sub
答案 0 :(得分:1)
你的许多Select Case
陈述确实会耗费大量时间。快速浏览一下,Case
与结果之间存在牢固的关系。以下示例显示了如何将K循环中的所有Select语句压缩为单个语句。
Dim R As Long
R = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 1).Value
If .ListObjects("Riesgo").DataBodyRange.Cells(1, 1) = Empty Then
.ListObjects("Riesgo").DataBodyRange.Cells(R - 1, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 2)
Else
.ListObjects("Riesgo").DataBodyRange.Cells(R - 1, 1) = .ListObjects("Riesgo").DataBodyRange.Cells(R - 1, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 2)
End If
不幸的是,这种关系始终不是-1
。因此,我建议您在进入K循环之前声明一个数组,如下所示: -
Dim Clm() As Variant
Clm = Array(2, 3, 4, 5, 6, 9, 10, 11, 12, 13, 28)
数组中的数字正是您的案例'条件。您应该将此列表扩展到130,这是您的最后一个案例'。借助此工具,您现在可以只用一个代替所有Case
语句: -
Dim Clm() As Variant ' Place your Dim statements
Dim C As Long, R As Long ' at the top of your code
Clm = Array(2, 3, 4, 5, 6, 9, 10, 11, 12, 13, 28)
' start the K-loop here
C = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 1).Value
R = Application.Match(C, Clm, 0)
With .ListObjects("Riesgo").DataBodyRange
If .Cells(1, 1) = Empty Then
.Cells(R, 1) = .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 2)
Else
.Cells(R, 1) = .Cells(R, 1) & " " & .ListObjects("consolidadoRiesgos").DataBodyRange.Cells(K + 1, 2)
End If
End With
如果找不到匹配项,则会发生错误。 Match
将返回数组中元素的编号,它恰好是您需要的行号。如果需要,您可以修改它。关键是Match
函数从一系列随机数中返回一个连续的数字。