Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1380to1384
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
1380to1384
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code verkleinern

Code verkleinern
10.09.2014 20:15:46
Ben
Hallo Zusammen :)
ich habe mal eine Frage.
Gibt es die Möglichkeit den folgenden Code kleiner werden zu lassen?
Bin gerade am kopieren, einfügen und Zahl ändern und das müsste ich noch bis Zeile 200 machen. :(
Man kann das doch sicher irgendwie kürzer und einfacher gestalten oder was meint ihr? :)
LG
Ben
Tabelle1.Range("B7") = Tabelle1.Range("AA7")
Tabelle1.Range("B8") = Tabelle1.Range("AA8")
Tabelle1.Range("B9") = Tabelle1.Range("AA9")
Tabelle1.Range("B10") = Tabelle1.Range("AA10")
Tabelle1.Range("B11") = Tabelle1.Range("AA11")
Tabelle1.Range("B12") = Tabelle1.Range("AA12")
Tabelle1.Range("B16") = Tabelle1.Range("AA16")
Tabelle1.Range("B17") = Tabelle1.Range("AA17")
Tabelle1.Range("B20") = Tabelle1.Range("AA20")
Tabelle1.Range("B21") = Tabelle1.Range("AA21")
Tabelle1.Range("B22") = Tabelle1.Range("AA22")
Tabelle1.Range("B26") = Tabelle1.Range("AA26")
Tabelle1.Range("B27") = Tabelle1.Range("AA27")
Tabelle1.Range("B28") = Tabelle1.Range("AA28")
Tabelle1.Range("B29") = Tabelle1.Range("AA29")
Tabelle1.Range("B30") = Tabelle1.Range("AA30")
Tabelle1.Range("B31") = Tabelle1.Range("AA31")
Tabelle1.Range("B32") = Tabelle1.Range("AA32")
Tabelle1.Range("B33") = Tabelle1.Range("AA33")
Tabelle1.Range("B35") = Tabelle1.Range("AA35")
Tabelle1.Range("B36") = Tabelle1.Range("AA36")
Tabelle1.Range("B37") = Tabelle1.Range("AA37")
Tabelle1.Range("B38") = Tabelle1.Range("AA38")
Tabelle1.Range("B39") = Tabelle1.Range("AA39")
Tabelle1.Range("B40") = Tabelle1.Range("AA40")
Tabelle1.Range("B41") = Tabelle1.Range("AA41")
Tabelle1.Range("B42") = Tabelle1.Range("AA42")

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code verkleinern
10.09.2014 20:40:36
Crazy
Hallo
warum nicht so? 
Sub kopieren()
Range("AA7:AA200").Copy
Range("B7").PasteSpecial xlPasteValues
End Sub

MfG Tom

AW: Code verkleinern
10.09.2014 20:53:51
Martin
Hallo Ben,
wenn wirklich der Bereich AA7 bis AA42 durchgehend übernommen werden kann, geht es sogar mit einem Einzeiler:
Tabelle1.Range("B7:B42").Value = Tabelle1.Range("AA7:AA42").Value
Viele Grüße
Martin

AW: Code verkleinern
10.09.2014 20:46:30
Martin
Hallo Ben,
bei dem Vorschlag von Crazy Tom werden alle Zellen übertragen (auch AA13 bis AA15, AA18 bis AA19 usw.)
Wenn wirklich nur die von dir angegebenen Zellen übertragen werden sollen, wäre folgender Code eine Möglichkeit: 
Sub Beispiel()
Dim i As Integer
With Tabelle1
For i = 1 To 42
Select Case i
Case 7 To 12, 16 To 17, 20 To 22, 26 To 33, 35 To 42
.Cells(i, 2) = .Cells(i, 27)
End Select
Next
End With
End Sub
Viele Grüße
Martin

Anzeige
...kleine Optimierung
10.09.2014 20:56:11
Martin
Hallo Ben,
eine kleine Optimierung ist noch möglich, indem die Schleife erst bei i = 7 loslegt:
Sub Beispiel()
Dim i As Integer
With Tabelle1
For i = 7 To 42
Select Case i
Case 7 To 12, 16 To 17, 20 To 22, 26 To 33, 35 To 42
.Cells(i, 2) = .Cells(i, 27)
End Select
Next
End With
End Sub
Viele Grüße
Martin

AW: Code verkleinern
10.09.2014 23:11:08
Daniel
Hi
Noch ne Möglichkeit unter Berücksichtigung der Lücken.
Alles, was lückenlos zusammen steht, kann auch gemeinsam kopiert werden.
dim AR as Range
For each AR in Range("b7:b12,b16:b17,b20:b22,b26:b33,b35:b42")
AR.Value = AR.offset(0, 25).value
Next
Gruß Daniel

Anzeige
AW: usp zu schnell
10.09.2014 23:14:07
Daniel
So ist's richtig 
dim AR as Range
For each AR in Range("b7:b12,b16:b17,b20:b22,b26:b33,b35:b42").Areas
AR.Value = AR.offset(0, 25).value
Next

Gruß Daniel

AW: Code verkleinern
10.09.2014 23:30:47
Gerd
Hallo Ben,
noch hübscher.
Dim Rng As Range, Ar As Range
Set Rng = Intersect(Tabelle1.Range("7:12,16:17,20:22,26:33,35:42"), Tabelle1.Columns(2))
For Each Ar In Rng.Areas
Ar.Value = Ar.Offset(, 25).Value
Next
Gruß Gerd

...gefällt mir sehr gut o.w.T.
11.09.2014 01:07:57
Martin
o.w.T.

doch noch eine Zeile eingespart ;-)
11.09.2014 01:16:02
Martin 

Dim ar As Range
For Each ar In Tabelle1.Range("B7:B12,B16:B17,B20:B22,B26:B33,B35:B42")
ar.Value = ar.Offset(0, 25).Value
Next
Viele Grüße
Martin

Anzeige
AW: Code verkleinern
11.09.2014 15:10:28
Ben
Hallo Zusammen,
vielen Dank für die Zahlreichen Antworten. :)
Werde später versuchen alle Möglichkeiten mal zu testen :)
Super das ihr gemerkt habt, dass da auch Lücken zwischen bleiben müssen.
LG
Ben

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige