Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Veredelung- Range.Value

Forumthread: Veredelung- Range.Value

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
Anzeige

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

Betreff
Benutzer
Anzeige
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

Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige