Veredelung- Range.Value

Forumthread: Veredelung- Range.Value

Stefan

Liebe VBA Experten,
ich denke mir, ihr werdet euch jetzt an den Kopf fassen, aber könntet ihr mir helfen den folgenden Code zu verkürzen so weit es geht? Ich möchte nicht, dass der Austausch der Werte solange dauert.
Tausen Dank für Eure Hilfe!

Sub Dropdown_EbenDB()
Application.ScreenUpdating = False
'Blattschutz_aus
If Range("U9") = "1" And Range("U27") = 1 Then
Range("H55").Value = Range("CT441")
Range("H56").Value = Range("CU441")
Range("H57").Value = Range("CV441")
Range("H58").Value = Range("CW441")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "2" And Range("U27") = 1 Then
Range("H55").Value = Range("CT441")
Range("H56").Value = Range("CU441")
Range("H57").Value = Range("CV441")
Range("H58").Value = Range("CW441")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "3" And Range("U27") = 1 Then
Range("H55").Value = Range("CT445")
Range("H56").Value = Range("CU445")
Range("H57").Value = Range("CV445")
Range("H58").Value = Range("CW445")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "4" And Range("U27") = 1 Then
Range("H55").Value = Range("CT448")
Range("H56").Value = Range("CU448")
Range("H57").Value = Range("CV448")
Range("H58").Value = Range("CW448")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "5" And Range("U27") = 1 Then
Range("H55").Value = Range("CT451")
Range("H56").Value = Range("CU451")
Range("H57").Value = Range("CV451")
Range("H58").Value = Range("CW451")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "6" And Range("U27") = 1 Then
Range("H55").Value = Range("CT454")
Range("H56").Value = Range("CU454")
Range("H57").Value = Range("CV454")
Range("H58").Value = Range("CW454")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "7" And Range("U27") = 1 Then
Range("H55").Value = Range("CT457")
Range("H56").Value = Range("CU457")
Range("H57").Value = Range("CV457")
Range("H58").Value = Range("CW457")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "8" And Range("U27") = 1 Then
Range("H55").Value = Range("CT460")
Range("H56").Value = Range("CU460")
Range("H57").Value = Range("CV460")
Range("H58").Value = Range("CW460")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "9" And Range("U27") = 1 Then
Range("H55").Value = Range("CT463")
Range("H56").Value = Range("CU463")
Range("H57").Value = Range("CV463")
Range("H58").Value = Range("CW463")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "10" And Range("U27") = 1 Then
Range("H55").Value = Range("CT466")
Range("H56").Value = Range("CU466")
Range("H57").Value = Range("CV466")
Range("H58").Value = Range("CW466")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
ElseIf Range("U9") = "11" And Range("U27") = 1 Then
Range("H55").Value = Range("CT469")
Range("H56").Value = Range("CU469")
Range("H57").Value = Range("CV469")
Range("H58").Value = Range("CW469")
Range("F92").Value = Range("H92")
Range("F93").Value = Range("H92")
Range("F94").Value = Range("H92")
Range("F95").Value = Range("H92")
End If
End Sub

Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Veredelung- Range.Value

18.04.2011 19:58:19

Hajo_Zi

Halo Stefan,
ich hätte den Code vielleicht so geküzzt, welchen Einfluss das auf die Zeit hat?

Option Explicit
Sub Dropdown_EbenDB()
Application.ScreenUpdating = False
'Blattschutz_aus
If (Range("U9") = "1" Or Range("U9") = "2") And Range("U27") = 1 Then
Range("H55").Value = Range("CT441")
Range("H56").Value = Range("CU441")
Range("H57").Value = Range("CV441")
Range("H58").Value = Range("CW441")
Range("F92:F95").Value = Range("H92")
ElseIf (Range("U9") = "3" Or Range("U9") = "4" Or _
Range("U9") = "5" Or Range("U9") = "6" Or _
Range("U9") = "7" Or Range("U9") = "8" Or _
Range("U9") = "9" Or Range("U9") = "10" Or _
Range("U9") = "11") And Range("U27") = 1 Then
Range("H55").Value = Range("CT" & (Range("U9") - 2) * 3 + 442)
Range("H56").Value = Range("CU" & (Range("U9") - 2) * 3 + 442)
Range("H57").Value = Range("CV" & (Range("U9") - 2) * 3 + 442)
Range("H58").Value = Range("CW" & (Range("U9") - 2) * 3 + 442)
Range("F92:F95").Value = Range("H92")
End If
Application.ScreenUpdating = True
End Sub

AW: Veredelung- Range.Value

18.04.2011 20:04:40

ransi

Hallo Stefan
So sollte das deutlich schneller gehen:

Option Explicit

Public Sub test()
    If Range("U27") = 1 Then
        Select Case Range("U9").Value
            Case 1
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT441:CW441"))
            Case 2
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT441:CW441"))
            Case 3
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT445:CW445"))
            Case 4
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT448:CW448"))
            Case 5
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT451:CW451"))
            Case 6
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT454:CW454"))
            Case 7
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT457:CW457"))
            Case 8
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT460:CW460"))
            Case 9
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT463:CW463"))
            Case 10
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT466:CW466"))
            Case 11
                Range("F92:F95") = Range("H92").Value
                Range("H55:H58") = WorksheetFunction.Transpose(Range("CT469:CW469"))
        End Select
    End If
End Sub

ransi

AW: Veredelung- Range.Value

19.04.2011 09:30:40

Timo

Hallo Ransi,
da die Zeile
Range("F92:F95") = Range("H92").Value
bei jedem der Case vorkommt und immer gleich ist, könnte die doch auch vorweg gestellt werden, oder?
(würde den Code nochmals verkürzen)

Public Sub test()
If Range("U27") = 1 Then
Range("F92:F95") = Range("H92").Value
Select Case Range("U9").Value
Case 1
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT441:CW441"))
Case 2
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT441:CW441"))
Case 3
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT445:CW445"))
Case 4
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT448:CW448"))
Case 5
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT451:CW451"))
Case 6
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT454:CW454"))
Case 7
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT457:CW457"))
Case 8
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT460:CW460"))
Case 9
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT463:CW463"))
Case 10
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT466:CW466"))
Case 11
Range("H55:H58") = WorksheetFunction.Transpose(Range("CT469:CW469"))
End Select
End If
End Sub

Gruß
Timo

AW: Veredelung- Range.Value

19.04.2011 09:38:07

Hajo_Zi

Hallo Timo,
jetzt würde es auch bei Range("U9").Value =12 oder 1,5 usw eingetragen werden. Case 1 und 2 könnte zusammengefast werden.
Gruß Hajo

AW: Veredelung- Range.Value

19.04.2011 10:13:43

Timo

Hallo Hajo,
da kein Case Else angegeben war, bin ich davon ausgegangen, dass nur Ganzzahlen von 1 bis 11 vorkommen können. - War auch nur ein "Schnellschuss". ;-)
Dass Case 1 und 2 zusammengefasst werden können, habe ich dabei dann auch übersehen. Trotz Brille...
8-)
Gruß
Timo

AW: Veredelung- Range.Value

18.04.2011 20:33:06

Gerd

Hallo Stefan!

Sub Dropdown_EbenDB()
Dim lngOffset As Long
'Blattschutz_aus ?
If Range("U27") = 1 Then
Application.ScreenUpdating = False
Select Case Range("U9").Value
Case 1 To 11
Range("F92:F95") = Range("H92").Value
If Range("U9").Value > 2 Then lngOffset = 1 + ((Range("U9").Value - 2) * 3)
Range("H55:58") = WorksheetFunction.Transpose(Range("CT441").Offset(lngOffset, 0). _
Resize(1, 4))
End Select
Application.ScreenUpdating = True
End If
End Sub

Gruß Gerd

AW: Veredelung- Range.Value

18.04.2011 22:31:50

Stefan

Wow vielen vielen Dank für eure zahlreichen Beiträge!!! Super klasse! Ich werde jetzt wohl die Qual der Wahl haben 
Nochmals tausend dank für eure Unterstützung!
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: Veredelung- Range.Value

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread