Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
Zellformel in VBA
23.04.2024 14:47:39
Formel SVERWEIS
23.04.2024 14:27:08
Excel - Zellen verketten anhand anderer Spalte
23.04.2024 14:23:45
Gehe zu Tabellenblatt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1208to1212
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1208to1212
1208to1212
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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

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
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
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige