Code VBA-technisch verbessern

Hallo werte "helfende"
Läßt sich diese Code (Makro) Programmiertechnisch (vielleicht auch in Sachen "performance") verbessern, kürzen, oder auch erneuern?
hier der Code:
Dim iR As Integer, iC As Integer, iRz As Integer, iCz As Integer, iSt As Integer
Dim iBeg As Integer, iEnd As Integer
iBeg = 15
iEnd = 71
iRz = 5
iCz = 2
iC = 4
iSt = ActiveCell.Column + 1
For iR = iBeg To iEnd
If Cells(iR, iSt - 1) = "K" Or Cells(iR, iSt - 1) = "U" Or Cells(iR, iSt - 1) = "F" Then GoTo WeiterMo
If Cells(iR, iSt) <> "" And Cells(iR, iSt).Interior.ColorIndex <> xlNone _
Or Cells(iR, iSt - 1) <> "" And Cells(iR, iSt - 1).Interior.ColorIndex <> xlNone Or Cells(iR, iSt - 1).Interior.ColorIndex = 15 Then
With shAushang
.Cells(iRz, iCz) = Cells(iR, iC)
.Cells(iRz, iCz - 1) = Cells(iR, iSt - 1)
End With
iRz = iRz + 1
WeiterMo: If Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex <> xlNone Or Cells(iR, iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
If Cells(iR, iSt) = "o" And Cells(iR, iSt).Interior.ColorIndex <> xlNone Or Cells(iR, iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = "V6"
ElseIf Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex <> xlNone Or Cells(iR, iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = "V8"
Else: shAushang.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
End If
End If
End If
Next
.......
Hat vielleicht jemand ne Idee dazu?
Gruß
Lorenz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

'am Anfang der Prozedur With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With 'am Ende der Prozedur With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With

Hallo
Das sollte etwas schneller sein weil nicht alle Prüfungen durchlaufen werden wenn eine zutrifft

Sub test()
Dim iR As Integer, iC As Integer, iRz As Integer, iCz As Integer, iSt As Integer
Dim iBeg As Integer, iEnd As Integer
'Diese Variable ist nicht deklariert
Dim shAushang As Worksheet
Set shAushang = Worksheets("Welcher Name ?")
iBeg = 15
iEnd = 71
iRz = 5
iCz = 2
iC = 4
iSt = ActiveCell.Column + 1
For iR = iBeg To iEnd
Select Case Cells(iR, iSt - 1)
Case "K", "U", "F"
If Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex  xlNone Or Cells(iR, _
iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
Next i
End If
If Cells(iR, iSt) = "o" And Cells(iR, iSt).Interior.ColorIndex  xlNone Or Cells( _
iR, iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = "V6"
Next i
End If
If Cells(iR, iSt)  "" And Cells(iR, iSt).Interior.ColorIndex  xlNone Or Cells( _
iR, iSt).Interior.ColorIndex = 6 Or Cells(iR, iSt).Interior.ColorIndex = 15 Then
shAushang.Cells(iRz - 1, iCz + 1) = "V8"
Else
shAushang.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
'Das muss hier noch dazu
iRz = iRz + 1
End If
Next i
End Select
If Cells(iR, iSt)  "" And Cells(iR, iSt).Interior.ColorIndex  xlNone _
Or Cells(iR, iSt - 1)  "" And Cells(iR, iSt - 1).Interior.ColorIndex  xlNone Or  _
Cells(iR, iSt - 1).Interior.ColorIndex = 15 Then
With shAushang
.Cells(iRz, iCz) = Cells(iR, iC)
.Cells(iRz, iCz - 1) = Cells(iR, iSt - 1)
End With
iRz = iRz + 1
End If
Next
End Sub

Die Optimierungen von Franz sind aber ebenfalls nötig um die Geschwindigkeit noch etwas zu erhöhen
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread