Microsoft Excel

Herbers Excel/VBA-Archiv

Code verkleinern

Betrifft: Code verkleinern von: Ben
Geschrieben am: 10.09.2014 20:15:46

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

  

Betrifft: AW: Code verkleinern von: Crazy Tom
Geschrieben am: 10.09.2014 20:40:36

Hallo

warum nicht so?

Sub kopieren()
    Range("AA7:AA200").Copy
    Range("B7").PasteSpecial xlPasteValues
End Sub

MfG Tom


  

Betrifft: AW: Code verkleinern von: Martin
Geschrieben am: 10.09.2014 20:53:51

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


  

Betrifft: AW: Code verkleinern von: Martin
Geschrieben am: 10.09.2014 20:46:30

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


  

Betrifft: ...kleine Optimierung von: Martin
Geschrieben am: 10.09.2014 20:56:11

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


  

Betrifft: AW: Code verkleinern von: Daniel
Geschrieben am: 10.09.2014 23:11:08

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


  

Betrifft: AW: usp zu schnell von: Daniel
Geschrieben am: 10.09.2014 23:14:07

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


  

Betrifft: AW: Code verkleinern von: Gerd L
Geschrieben am: 10.09.2014 23:30:47

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


  

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

o.w.T.


  

Betrifft: doch noch eine Zeile eingespart ;-) von: Martin
Geschrieben am: 11.09.2014 01:16:02

    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


  

Betrifft: AW: Code verkleinern von: Ben
Geschrieben am: 11.09.2014 15:10:28

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