PDA

Vollständige Version anzeigen : Makroausführung bei bestimmten Abreitsblättern verhindern


OAPlayer2306
27.06.2014, 09:52
Guten morgen zusammen,
ich arbeite mit einem Makro, das auf jedem Blatt seine Aufgabe erfüllt: Sub Namenauflösen1()
'
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
Range("B1").Select
ActiveCell.FormulaR1C1 = "System:"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Server:"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-2],LEN(RC1)-29)"
Range("E1").Select
ActiveCell.FormulaR1C1 = _
"=DATE((MID(RC1,FIND(""20"",RC1,1)+0,4)),(MID(RC1,FIND(""20"",RC1,1)+4,2)),(MID(RC1,FIND(""20"",RC1,1)+6,2)))"
Range("G1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-6],14)"
Cells.Select
Selection.Columns.AutoFit
Range("A2").Select
Next
End Sub

Wie kann ich verhindern, daß das Makro auf bestimmten Blättern ausgeführt wird?
Z.B. soll auf den Tabellenblättern "Auswertung", "Daten" und "Test" der Zellinhalt von A1 nicht aufgelöst werden.

Viel Spaß,
OAPlayer2306
:confused:

RPP63neu
27.06.2014, 10:07
Hallo!
Schmeiße mal Deine ganzen .Select und .Activate raus, die sind unnötig wie ein Kropf (hat aber nichts mit Deiner Frage zu tun).

Um bestimmte Sheets auszuschließen, macht man das z.B. so:
Sub Namenauflösen1()
'
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "Auswertung", "Daten", "Test"
'mache nix!
Case Else
'Dein Code
End Select
Next
End Sub
Gruß, Ralf

mumpel
27.06.2014, 10:07
Hallo!

Arbeite mit Select Case. Und bitte verzichte auf "Select" und "Activate".

<pre style='border:thin solid #FF8000; padding:12px 24px; margin-left:12px; color:#000000'><span style='color:#0000EE'>Sub</span> Namenaufl&ouml;sen1() <span style='color:#0000EE'>Dim</span> Blatt <span style='color:#0000EE'>As</span> <span style='color:#0000EE'>Object</span> <span style='color:#0000EE'>For</span> <span style='color:#0000EE'>Each</span> Blatt <span style='color:#0000EE'>In</span> ActiveWorkbook.Worksheets <span style='color:#0000EE'>Select</span> <span style='color:#0000EE'>Case</span> Blatt.Name <span style='color:#0000EE'>Case</span> <span style='color:#FF0000'>&quot;Tabelle1&quot;</span> <span style='color:#0000EE'>With</span> Sheets(Blatt.Name) .Range(<span style='color:#FF0000'>&quot;B1&quot;</span>).Value = <span style='color:#FF0000'>&quot;System:&quot;</span> .Range(<span style='color:#FF0000'>&quot;D1&quot;</span>).Value = <span style='color:#FF0000'>&quot;Date:&quot;</span> .Range(<span style='color:#FF0000'>&quot;C1&quot;</span>).FormulaR1C1 = <span style='color:#FF0000'>&quot;=LEFT(RC[-2],LEN(RC1)-29)&quot;</span> <span style='color:#0000EE'>End</span> <span style='color:#0000EE'>With</span> <span style='color:#0000EE'>Case</span> <span style='color:#FF0000'>&quot;Tabelle2&quot;</span> <span style='color:#0000EE'>With</span> Sheets(Blatt.Name) .Range(<span style='color:#FF0000'>&quot;C1&quot;</span>).Value = <span style='color:#FF0000'>&quot;System:&quot;</span> .Range(<span style='color:#FF0000'>&quot;D1&quot;</span>).Value = <span style='color:#FF0000'>&quot;Date:&quot;</span> .Range(<span style='color:#FF0000'>&quot;E1&quot;</span>).FormulaR1C1 = <span style='color:#FF0000'>&quot;=LEFT(RC[-2],LEN(RC1)-29)&quot;</span> <span style='color:#0000EE'>End</span> <span style='color:#0000EE'>With</span> <span style='color:#0000EE'>End</span> <span style='color:#0000EE'>Select</span> <span style='color:#0000EE'>Next</span> Blatt <span style='color:#0000EE'>End</span> <span style='color:#0000EE'>Sub</span><br><br><hr style='color: #FF8000; background-color: #3300B2; height: 1.5px;' /><br><br><p style='font-size: 8px; font-family: Verdana; text-align: right;'><a href='http://www.rholtz-office.de/index.php?index=vbahtml' target='_blank'>VBA/HTML - CodeConverter f&uuml;r Office-Foren</a><br>AddIn f&uuml;r Excel/Word 2000-2010 - komplett in VBA geschrieben von <a href='http://www.office-loesung.de/viewprofile19265.php'>Lukas Mosimann</a><br />Projektbetreuung durch mumpel</p><br /><br />Code erstellt und getestet in Office 15</pre>

Gruß, René

Mc Santa
27.06.2014, 10:10
Hallo,

so sollte es gehen:
Option Explicit

Sub Namenauflösen1()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "Auswertung", "Daten", "Test"
Case Else
With sh
.Range("B1").FormulaR1C1 = "System:"
.Range("C1").FormulaR1C1 = "=LEFT(RC[-2],LEN(RC1)-29)"
.Range("D1").FormulaR1C1 = "Date:"
.Range("E1").FormulaR1C1 = _
"=DATE((MID(RC1,FIND(""20"",RC1,1)+0,4)),(MID(RC1,FIND(""20"",RC1,1)+4,2)),(MID(RC1,FIND(""20"",RC1,1)+6,2)))"
.Range("F1").FormulaR1C1 = "Server:"
.Range("G1").FormulaR1C1 = "=RIGHT(RC[-6],14)"
.Cells.Columns.AutoFit
.Range("A2").Select
End With
End Select
Next sh
End Sub

Hilft dir das weiter und funktioniert es bei dir?
VG

OAPlayer2306
27.06.2014, 10:30
Hallo Mc Santa,
das funktioniert wunderbar.
Nachdem ich die Zeile .Range("A2").Select gelöscht habe, weil sie einen Fehler verursachte und eigentlich unnötig ist, gab es keine Probleme.

Vielen Dank an alle,
OAPlayer2306 :)