Macro kürzen?

Bild

Betrifft: Macro kürzen?
von: Rene
Geschrieben am: 22.04.2005 09:39:23
Moin zusammen,
Habe mir dieses erstellt:
'kopiert den Inhalt bei geschlossener Tabelle

strSource = "'C:\Test\[Tabelle1.xls]Liste'!"
With Workbooks("Liste.xls").Worksheets("Liste")
.Range("G7").Value = xl4Value(strSource & "R7C7")
.Range("G8").Value = xl4Value(strSource & "R8C7")
.Range("G9").Value = xl4Value(strSource & "R9C7")
.Range("G10").Value = xl4Value(strSource & "R10C7")
.Range("G11").Value = xl4Value(strSource & "R11C7")
.Range("G12").Value = xl4Value(strSource & "R12C7")
.Range("G13").Value = xl4Value(strSource & "R13C7")
.Range("G14").Value = xl4Value(strSource & "R14C7")
.Range("G15").Value = xl4Value(strSource & "R15C7")
.Range("G16").Value = xl4Value(strSource & "R16C7")
.Range("G17").Value = xl4Value(strSource & "R17C7")
.Range("G18").Value = xl4Value(strSource & "R18C7")
.Range("G19").Value = xl4Value(strSource & "R19C7")
.Range("G20").Value = xl4Value(strSource & "R20C7")
.Range("G21").Value = xl4Value(strSource & "R21C7")
.Range("G22").Value = xl4Value(strSource & "R22C7")
.Range("G23").Value = xl4Value(strSource & "R23C7")
.Range("G24").Value = xl4Value(strSource & "R24C7")
.Range("G25").Value = xl4Value(strSource & "R25C7")
.Range("G26").Value = xl4Value(strSource & "R26C7")
.Range("G27").Value = xl4Value(strSource & "R27C7")
.Range("G28").Value = xl4Value(strSource & "R28C7")
.Range("G29").Value = xl4Value(strSource & "R29C7")
.Range("G30").Value = xl4Value(strSource & "R30C7")
.Range("G31").Value = xl4Value(strSource & "R31C7")
.Range("G32").Value = xl4Value(strSource & "R32C7")
.Range("G33").Value = xl4Value(strSource & "R33C7")
.Range("G34").Value = xl4Value(strSource & "R34C7")
.Range("G35").Value = xl4Value(strSource & "R35C7")
.Range("G36").Value = xl4Value(strSource & "R36C7")
.Range("G37").Value = xl4Value(strSource & "R37C7")
.Range("G38").Value = xl4Value(strSource & "R38C7")
.Range("G39").Value = xl4Value(strSource & "R39C7")
.Range("G40").Value = xl4Value(strSource & "R40C7")
.Range("G41").Value = xl4Value(strSource & "R41C7")
.Range("G42").Value = xl4Value(strSource & "R42C7")
.Range("G43").Value = xl4Value(strSource & "R43C7")
.Range("G44").Value = xl4Value(strSource & "R44C7")
.Range("G45").Value = xl4Value(strSource & "R45C7")
.Range("G46").Value = xl4Value(strSource & "R46C7")
.Range("G47").Value = xl4Value(strSource & "R47C7")
.Range("G48").Value = xl4Value(strSource & "R48C7")
.Range("G49").Value = xl4Value(strSource & "R49C7")
.Range("G50").Value = xl4Value(strSource & "R50C7")
.Range("G51").Value = xl4Value(strSource & "R51C7")
.Range("G52").Value = xl4Value(strSource & "R52C7")
.Range("G53").Value = xl4Value(strSource & "R53C7")
.Range("G54").Value = xl4Value(strSource & "R54C7")
.Range("G55").Value = xl4Value(strSource & "R55C7")
.Range("G56").Value = xl4Value(strSource & "R56C7")
.Range("G57").Value = xl4Value(strSource & "R57C7")
.Range("G58").Value = xl4Value(strSource & "R58C7")
.Range("G59").Value = xl4Value(strSource & "R59C7")
.Range("G60").Value = xl4Value(strSource & "R60C7")
.Range("G61").Value = xl4Value(strSource & "R61C7")
.Range("G62").Value = xl4Value(strSource & "R62C7")
.Range("G63").Value = xl4Value(strSource & "R63C7")
.Range("G64").Value = xl4Value(strSource & "R64C7")
.Range("G65").Value = xl4Value(strSource & "R65C7")
.Range("G66").Value = xl4Value(strSource & "R66C7")
.Range("G67").Value = xl4Value(strSource & "R67C7")
.Range("G68").Value = xl4Value(strSource & "R68C7")
.Range("G69").Value = xl4Value(strSource & "R69C7")
.Range("G70").Value = xl4Value(strSource & "R70C7")
.Range("G71").Value = xl4Value(strSource & "R71C7")
.Range("G72").Value = xl4Value(strSource & "R72C7")
.Range("G73").Value = xl4Value(strSource & "R73C7")
.Range("G74").Value = xl4Value(strSource & "R74C7")
.Range("G75").Value = xl4Value(strSource & "R75C7")
.Range("G76").Value = xl4Value(strSource & "R76C7")
.Range("G77").Value = xl4Value(strSource & "R77C7")
.Range("G78").Value = xl4Value(strSource & "R78C7")
.Range("G79").Value = xl4Value(strSource & "R79C7")
.Range("G80").Value = xl4Value(strSource & "R80C7")
.Range("G81").Value = xl4Value(strSource & "R81C7")
.Range("G82").Value = xl4Value(strSource & "R82C7")
.Range("G83").Value = xl4Value(strSource & "R83C7")
.Range("G84").Value = xl4Value(strSource & "R84C7")
.Range("G85").Value = xl4Value(strSource & "R85C7")
.Range("G86").Value = xl4Value(strSource & "R86C7")
.Range("H7").Value = xl4Value(strSource & "R7C8")
.Range("H8").Value = xl4Value(strSource & "R8C8")
.Range("H9").Value = xl4Value(strSource & "R9C8")
.Range("H10").Value = xl4Value(strSource & "R10C8")
.Range("H11").Value = xl4Value(strSource & "R11C8")
.Range("H12").Value = xl4Value(strSource & "R12C8")
.Range("H13").Value = xl4Value(strSource & "R13C8")
.Range("H14").Value = xl4Value(strSource & "R14C8")
.Range("H15").Value = xl4Value(strSource & "R15C8")
.Range("H16").Value = xl4Value(strSource & "R16C8")
.Range("H17").Value = xl4Value(strSource & "R17C8")
.Range("H18").Value = xl4Value(strSource & "R18C8")
.Range("H19").Value = xl4Value(strSource & "R19C8")
.Range("H20").Value = xl4Value(strSource & "R20C8")
.Range("H21").Value = xl4Value(strSource & "R21C8")
.Range("H22").Value = xl4Value(strSource & "R22C8")
.Range("H23").Value = xl4Value(strSource & "R23C8")
.Range("H24").Value = xl4Value(strSource & "R24C8")
.Range("H25").Value = xl4Value(strSource & "R25C8")
.Range("H26").Value = xl4Value(strSource & "R26C8")
.Range("H27").Value = xl4Value(strSource & "R27C8")
.Range("H28").Value = xl4Value(strSource & "R28C8")
.Range("H29").Value = xl4Value(strSource & "R29C8")
.Range("H30").Value = xl4Value(strSource & "R30C8")
.Range("H31").Value = xl4Value(strSource & "R31C8")
.Range("H32").Value = xl4Value(strSource & "R32C8")
.Range("H33").Value = xl4Value(strSource & "R33C8")
.Range("H34").Value = xl4Value(strSource & "R34C8")
.Range("H35").Value = xl4Value(strSource & "R35C8")
.Range("H36").Value = xl4Value(strSource & "R36C8")
.Range("H37").Value = xl4Value(strSource & "R37C8")
.Range("H38").Value = xl4Value(strSource & "R38C8")
.Range("H39").Value = xl4Value(strSource & "R39C8")
.Range("H40").Value = xl4Value(strSource & "R40C8")
.Range("H41").Value = xl4Value(strSource & "R41C8")
.Range("H42").Value = xl4Value(strSource & "R42C8")
.Range("H43").Value = xl4Value(strSource & "R43C8")
.Range("H44").Value = xl4Value(strSource & "R44C8")
.Range("H45").Value = xl4Value(strSource & "R45C8")
.Range("H46").Value = xl4Value(strSource & "R46C8")
.Range("H47").Value = xl4Value(strSource & "R47C8")
.Range("H48").Value = xl4Value(strSource & "R48C8")
.Range("H49").Value = xl4Value(strSource & "R49C8")
.Range("H50").Value = xl4Value(strSource & "R50C8")
.Range("H51").Value = xl4Value(strSource & "R51C8")
.Range("H52").Value = xl4Value(strSource & "R52C8")
.Range("H53").Value = xl4Value(strSource & "R53C8")
.Range("H54").Value = xl4Value(strSource & "R54C8")
.Range("H55").Value = xl4Value(strSource & "R55C8")
.Range("H56").Value = xl4Value(strSource & "R56C8")
.Range("H57").Value = xl4Value(strSource & "R57C8")
.Range("H58").Value = xl4Value(strSource & "R58C8")
.Range("H59").Value = xl4Value(strSource & "R59C8")
.Range("H60").Value = xl4Value(strSource & "R60C8")
.Range("H61").Value = xl4Value(strSource & "R61C8")
.Range("H62").Value = xl4Value(strSource & "R62C8")
.Range("H63").Value = xl4Value(strSource & "R63C8")
.Range("H64").Value = xl4Value(strSource & "R64C8")
.Range("H65").Value = xl4Value(strSource & "R65C8")
.Range("H66").Value = xl4Value(strSource & "R66C8")
.Range("H67").Value = xl4Value(strSource & "R67C8")
.Range("H68").Value = xl4Value(strSource & "R68C8")
.Range("H69").Value = xl4Value(strSource & "R69C8")
.Range("H70").Value = xl4Value(strSource & "R70C8")
.Range("H71").Value = xl4Value(strSource & "R71C8")
.Range("H72").Value = xl4Value(strSource & "R72C8")
.Range("H73").Value = xl4Value(strSource & "R73C8")
.Range("H74").Value = xl4Value(strSource & "R74C8")
.Range("H75").Value = xl4Value(strSource & "R75C8")
.Range("H76").Value = xl4Value(strSource & "R76C8")
.Range("H77").Value = xl4Value(strSource & "R77C8")
.Range("H78").Value = xl4Value(strSource & "R78C8")
.Range("H79").Value = xl4Value(strSource & "R79C8")
.Range("H80").Value = xl4Value(strSource & "R80C8")
.Range("H81").Value = xl4Value(strSource & "R81C8")
.Range("H82").Value = xl4Value(strSource & "R82C8")
.Range("H83").Value = xl4Value(strSource & "R83C8")
.Range("H84").Value = xl4Value(strSource & "R84C8")
.Range("H85").Value = xl4Value(strSource & "R85C8")
.Range("H86").Value = xl4Value(strSource & "R86C8")
End With
End If
Next
End With
'löscht den Zellinhalt wenn Wert "0" ist
For Each zelle In ActiveSheet.Range("G7:G87")
If zelle.Value = "0" Then
zelle.ClearContents
End If
meine Frage ist nun ob man dieses auch kürzer schreiben könnte? Es geht zwar auch so aber es wäre schön wenn es kürzer wäre.
Gruß Rene

Bild

Betrifft: AW: Macro kürzen?
von: Michel
Geschrieben am: 22.04.2005 09:53:06
Hi,
ungetestet:
Dim i%

With Workbooks("Liste.xls").Worksheets("Liste")
For i = 7 To 86
.Range("G" & i).Value = xl4Value(strSource & "R" & i & "C7")
.Range("H" & i).Value = xl4Value(strSource & "R" & i & "C8")
Next i
End With
cu
Michel
Bild

Betrifft: AW: Macro kürzen?
von: Rene
Geschrieben am: 22.04.2005 10:26:43
Hi Michael,
Habe deinen Code Getestet und es geht. Danke auch dir Marcel für deine Mühe.
Hätte da aber noch eine Frage. Wie könnte ich es anstellen das wenn ein Macro läuft der Button den ich gedrückt habe die Farbe ändert gibt es da eine Möglichkeit? Ich würde aber auch die Frage neu einstellen das auch die anderen bei einer Antwort dazu Hilfe erhalten.
Gruß Rene
Bild

Betrifft: AW: Macro kürzen?
von: Michel
Geschrieben am: 22.04.2005 12:50:22
Hi,
die Farbe kannst du ändern - no prob!
Me.DeinButton.Backcolor = RGB(255,255,192)
Dennoch denke ich, das die Prozedur so schnell abläuft, das du Farbe gar nicht mehr mitbekommen wirst :-)
Bild

Betrifft: AW: Macro kürzen?
von: marcl
Geschrieben am: 22.04.2005 09:53:06
Moin Rene,
probier mal das: habe ich aber nicht getetet

Sub test()
...
strSource = "'C:\Test\[Tabelle1.xls]Liste'!"
With Workbooks("Liste.xls").Worksheets("Liste")
zahl = 7
Do While zahl < 87
.Range("G" & zahl).Value = xl4Value(strSource & "R" & zahl & "C7")
zahl = zahl + 1
Loop
zahl = 7
Do While zahl < 87
.Range("H" & zahl).Value = xl4Value(strSource & "R" & zahl & "C8")
zahl = zahl + 1
Loop
'löscht den Zellinhalt wenn Wert "0" ist
For Each zelle In ActiveSheet.Range("G7:G87")
If zelle.Value = "0" Then
zelle.ClearContents
End If
...
End Sub

Gruß
marcl
 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA Projekt nicht schützen!"