Supportnet / Forum / Skripte(PHP,ASP,Perl...)

Hallo zusammen, habe nachfolgend aufgeführtes Makro in Excel (Version 2003), welches für mehrere Tabellen hergenommen wird. In den einzelnen Tabellen befinden sich mehrere (teilweise über 100) Arbeitsblätter (Name der Tabellenblätter u. a. Artikelbezeichnungen wie „Gewürze, Därme, Kartonagen, Folien, Etiketten, Beutel, Becher-Deckel“ und Artikel-Nr. wie "51000, 51002, 5123, 7153,…."). Wenn ich das nachfolgende Makro ausführe, wird es nur im derzeit aktuellen Arbeitsblatt durchgeführt. Muss ich jetzt für die Definition des Bereichs „Sheets(Array("Kartonagen","Därme",….,"51000",51002...)).Select“ jedes Tabellenblatt angeben oder geht’s auch kürzer, so dass einfach alle Tabellenblätter in der jeweiligen Tabelle angesprochen werden? Mein Makro lautet bisher: Option Explicit Sub Aktualisieren() Dim Bereich As Range Dim VergleichsBereich As Range Dim Zelle As Range Dim I As Long Set Bereich = ActiveSheet.Range("D6:D999") Set VergleichsBereich = ActiveSheet.Range("F1") For Each Zelle In Bereich If Zelle.Value <> VergleichsBereich.Value And _ TypeName(Zelle.Value) <> "String" And _ TypeName(Zelle.Value) <> "Empty" Then For I = 0 To -3 Step -1 Zelle.Offset(0, I).ClearContents Next I End If Next Zelle Set Bereich = Nothing Set VergleichsBereich = Nothing End Sub Wäre super, wenn mir jemand helfen könnte! Mit freundlichen Grüßen Flo07

Hallo Flo,

ich weiß jetzt nicht, ob ich Dich richtig verstanden habe, aber nachfolgends Makro sollte nacheinander in allen Tabellenblättern, die in der aktuelle Arbeitsmappe sind, ausgeführt werden.

Option Explicit

Sub Aktualisieren()
Dim Bereich As Range
Dim VergleichsBereich As Range
Dim Zelle As Range
Dim I As Long, iTabelle As Integer

For iTabelle = 1 To Worksheets.Count

Set Bereich = Sheet(iTabelle).Range("D6:D999")
Set VergleichsBereich = Sheet(iTabelle).Range("F1")

For Each Zelle In Bereich

If Zelle.Value <> VergleichsBereich.Value And _
TypeName(Zelle.Value) <> "String" And _
TypeName(Zelle.Value) <> "Empty" Then
For I = 0 To -3 Step -1
Zelle.Offset(0, I).ClearContents
Next I
End If
Next Zelle

Set Bereich = Nothing
Set VergleichsBereich = Nothing
Next
End Sub

Ich hoffe, Du meintest das so. Wenn nicht, melde Dich.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hi zusammen, brauch dringend eure Hilfe! Habe in meine UserForm1 einen Befehlsbutton namens „Artikel einlagern“ eingefügt. Wenn nun dieser Button gedrückt wird, soll folgendes geschehen. Eine neue Userform mit den Abfragen-Punkten „Artikel-Nr.“, „Einlagerungs-Datum“, „Menge“ und „Anzahl der Positionen“ soll geöffnet werden (soll jeweils über Textfeld befüllbar sein). Bei der Eingabe der Artikel-Nr. im entsprechenden Feld soll das Makro diesen in allen geöffneten Arbeitsmappen suchen bis es die gesuchte Artikel-Nr. gefunden hat. (Habe zum Suchen schon ein Makro, dass evtl. in die Lösung mit eingebaut werden könnte!) Von diesem Punkt aus, soll in die erste leere Zeile (bzw. wenn Spalte A leer ist (in den Spalten E, F, G befinden sich, wenn keine Einlagerung mehr vorhanden is, Formeln)also ist daher die Zeile nicht komplett leer) gegangen werden.Anschließend soll gem. des Eintrages in „Anzahl der Positionen“ bis zur ersten leeren Zeile gegangen werden und dann dementsprechend viele Zeilen eingefügt werden (die vorhanden Formeln in der ersten freien Zeile (Wenn noch Einlagerungen vorhanden dann befinden sich die Formeln in der darüber liegendenZeile) sollen übernommen werden). Der Eintrag in „Einlagerungs-Datum“ soll dann in allen Zeilen in Spalte B und bei „Menge“ in allen Zeilen in Spalte C übernommen werden, sobald der Benutzer seine Eingaben in den Textfeldern gemacht und den Button "Einlagern" gedrückt hat. Ist ziemlich kompliziert, oder? Wenn das jemand hinkriegen sollte, zücke ich meinen imaginären Hut vor Hochachtung! Wäre euch für eure Hilfe sehr dankbar!

Hier mein Such-Makro:









Public Sub Suchen()
Dim WB As Workbook
Dim strInbox As String
Dim zelle As Range
Dim intWks As Integer
Dim Wahl As String
Dim FirstAddress
Dim bln As Boolean


strInbox = InputBox("ARTIKELSUCHE")
If strInbox = "" Then
Exit Sub
End If
For Each WB In Workbooks
WB.Activate
For intWks = 1 To ActiveWorkbook.Sheets.Count
With Worksheets(intWks).UsedRange
Set zelle = .Find(strInbox, LookIn:=xlValues)
If Not zelle Is Nothing Then
FirstAddress = zelle.Address
bln = True
Do
Worksheets(intWks).Select
zelle.Select
Wahl = _
MsgBox("[ " & strInbox & " ] gefunden in: " & vbCr _
& vbCr & "Mappe: " & WB.Name _
& vbCr & "Tabelle: " & Worksheets(intWks).Name _
& vbCr & " Zelle: " & zelle.Address(0, 0) _
& vbCr & vbCr & "Weitersuchen?", vbYesNo)
If Wahl = vbNo Then
Set zelle = Nothing
Exit Sub
End If
Set zelle = .FindNext(zelle)
Loop While Not zelle Is Nothing And zelle.Address <> FirstAddress
End If
End With
Next intWks
Next WB

If bln = False Then
MsgBox "Der Suchbegriff [" & strInbox & "] wurde nicht gefunden."
End If
Set zelle = Nothing
Workbooks.Activate
End Sub





Vielen Dank schon mal für euer Bemühen!

Grüße

Flo07

• Daten aus anderen Tabellenblättern importieren
• inTabelle die freien Zellen löschen
• zeilen per makro ausblenden
• makro zum benennen von tabellenblättern