Code intelligenter schreiben ?!
21.02.2018 12:54:46
David
ich habe eine Schleife geschrieben um viele Spalten zu durchsuchen und im Falle eines Variablenfund sollen Werte kopiert werden und in entsprechende Zellen der angesprochenen Spalte hinzuaddiert werden.
Dies klappt auch mit diesem Code.....zum einen leider dauert die Berechnung relativ lange und zum anderen würde ich gerne wissen, ob es möglich ist den Code so zu schreiben dass dieser ständig auf Veränderungen in den Spalten reagiert. Sozusagen in Echtzeit die Spalten ausließt.
Vielleicht habt ihr ja ein Tipp für mich...
Hier der Code
Sub schleife()
Dim i As Long
Dim J As Long
For i = 11 To 45
For J = 3 To 451
If Cells(i, J) = "MAR IS2" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "T6 PA" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "T6 PA VFF" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "T6 PA PVS" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "T6 PA MAR IS3" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "T6 PA MAR PVS" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "1.VT" Then
Range("E94:E97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "2.VT" Then
Range("F94:F97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "3.VT" Then
Range("G94:G97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "M100" Then
Range("H94:H97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "1.AT" Then
Range("I94:I97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "2.AT" Then
Range("J94:J97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "3.AT" Then
Range("K94:K97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "4.AT" Then
Range("L94:L97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "5.AT" Then
Range("M94:M97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "6.AT" Then
Range("N94:N97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "NB" Then
Range("O94:O97").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "M100 T6 Serie" Then
Range("E103:E106").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
If Cells(i, J) = "Tisch" Then
Range("E113:E116").Copy
Cells(46, J).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
End If
Next
Next
End Sub