PDA

Vollständige Version anzeigen : Automatische Filterung


media
11.07.2006, 14:51
Hallo,

ich habe ein Scheet, auf dem es viele Einträge der folgenden Art gibt:

Monatsumsatz der Märtke
Ettlingen 232323
Bruchsal 656546
Mannheim 56465456
Jahresumsatz der Märkte 545465
Ettlingen 54545
Bruchsal 351355
Mannheim 565656
Lagerbestand der Märkte
Ettlingen 655666
Bruchsal 5665456
Mannheim 564564


Davon gibt es von vielen Standorten Einträge des selben Schemas.

Ich möchte nun gerne automatisch per VBA automatisch die Daten der Standorte Bruchsal, Mannheim, Ettlingen ausfiltern, die zwischen Jahresumsatz und Lagerbestand stehen und in ein anderes Blatt kopieren.

Gibt es eine Möglichkeit?

Grüsse

media

jinx
11.07.2006, 19:42
<font size="2" face="Century Gothic">Moin, media,

bezogen auf die Beschreibung für die Tabellenfunktionen: Suchen des Begriffes Jahresumsatz, kopieren der darauffolgenden 3 Zeilen, Einfügen in einer neuen Tabelle. Vorgehen kann per Makro-Recorder aufgenommen und nachbearbeitet werden... ;) sollte es dann auch: Variablen setzen, Zielbereich variabel halten :grins:</font>

media
11.07.2006, 20:56
Hallo Jinx,
danke für die Hilfe, aber ich habe wiedermal ein wenig falsch erklärt-)

Im Anhang findest du eine Tabelle mit einem Beipiel.

In dieser Tabelle sind von vielen Standorten die Tages und Monats und Jahresumsätze untereinander stehend, sowie die Lagerbestände.

Ich muss mit dieser Tabelle automatisch ein Tagesumsatzranking generieren.

Wäre auch ganz einfach, wenn nicht die Monatssumsätze und die Jahresumsätze wie die Lagersbesände dazwischenstehen würden, was mir das absteigende Sortieren verhindert.

Ich muss also genau die Daten die sich zwischen der Zeile Tages und der Zeile Monatsumsätze befinden ausfiltern. Aber in real stehen da noch weitere 200 Märkte drin mit ebenfalls Lager, Monats und Jahresumsatz...

Schwitz....

Grüsse

Thomas

jinx
12.07.2006, 17:55
<font size="2" face="Century Gothic">Moin, Thomas,

wirklich ein origineller Name für einen Anhang ;) Und die Suchbegriffe aus dem ersten Thread kommen auch nicht vor. :p Als Ausgleich hast Du uns dann zusätzliche Leerzeichen spendiert... :grins:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> Auswahl()
<span class="REM">' Grundlage: Herber 058499</span>
<span class="TOKEN">Dim</span> rngRange <span class="TOKEN">As</span> Range
<span class="TOKEN">Dim</span> strSearch <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> strAddress <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> myArray <span class="TOKEN">As</span> Variant
<span class="TOKEN">Dim</span> lngTarget <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> intCounter <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> bytCounter <span class="TOKEN">As</span> <span class="TOKEN">Byte</span>
&nbsp;
<span class="TOKEN">If</span> <span class="TOKEN">Not</span> ActiveSheet.Name = &quot;Tabelle1&quot; <span class="TOKEN">Then</span>
MsgBox &quot;Bitte auf die Datentabelle zur Ausf&uuml;hrung des Makros wechseln&quot;, vbCritical, &quot;Hinweis&quot;
<span class="TOKEN">Exit Sub</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
Range(&quot;A1&quot;).Select
myArray = Array(&quot;Erfurt&quot;, &quot;Plauen&quot;, &quot;Jena&quot;)
strSearch = &quot;Jahresumsatz der Maerkte&quot;
lngTarget = 2
intCounter = Sheets(&quot;Tabelle2&quot;).Cells(Rows.Count, 1).End(xlUp).Row + 1
&nbsp;
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">Set</span> rngRange = ActiveSheet.Columns(&quot;A:A&quot;).Find( _
what:=strSearch, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows)
<span class="TOKEN">If</span> rngRange <span class="TOKEN">Is</span> <span class="TOKEN">Nothing</span> <span class="TOKEN">Then</span>
Beep
MsgBox prompt:=&quot;Suchbegriff nicht gefunden!&quot;
<span class="TOKEN">Exit Sub</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
&nbsp;
strAddress = rngRange.Address
<span class="TOKEN">Do</span>
<span class="TOKEN">For</span> bytCounter = <span class="TOKEN">LBound</span>(myArray) <span class="TOKEN">To</span> <span class="TOKEN">UBound</span>(myArray)
<span class="TOKEN">If</span> InStr(1, myArray(bytCounter), rngRange.Offset(intCounter, 0).Value) &gt; 0 <span class="TOKEN">Then</span>
Sheets(&quot;Tabelle2&quot;).Range(Cells(lngTarget, 1), Cells(lngTarget, 3)) = _
Range(rngRange, Cells(rngRange.Offset(intCounter, 2)))
lngTarget = lngTarget + 1
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Next</span> bytCounter
intCounter = intCounter + 1
<span class="TOKEN">Loop</span> <span class="TOKEN">Until</span> Right(Trim(rngRange.Offset(intCounter, 0).Value), 7) = &quot;Gesamt:&quot;
&nbsp;
<span class="TOKEN">While</span> ActiveCell.Address &lt;&gt; strAddress
intCounter = 2
<span class="TOKEN">Set</span> rngRange = Cells.FindNext(After:=rngRange)
<span class="TOKEN">If</span> rngRange.Address = strAddress <span class="TOKEN">Then</span> <span class="TOKEN">Exit Sub</span>
<span class="TOKEN">Do</span>
<span class="TOKEN">For</span> bytCounter = <span class="TOKEN">LBound</span>(myArray) <span class="TOKEN">To</span> <span class="TOKEN">UBound</span>(myArray)
<span class="TOKEN">If</span> InStr(1, myArray(bytCounter), rngRange.Offset(intCounter, 0).Value) &gt; 0 <span class="TOKEN">Then</span>
Sheets(&quot;Tabelle2&quot;).Cells(lngTarget, 1).Resize(1, 3).Value = _
rngRange.Offset(intCounter, 0).Resize(1, 3).Value
lngTarget = lngTarget + 1
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Next</span> bytCounter
intCounter = intCounter + 1
<span class="TOKEN">Loop</span> <span class="TOKEN">Until</span> Right(Trim(rngRange.Offset(intCounter, 0).Value), 7) = &quot;Gesamt:&quot;
<span class="TOKEN">Wend</span>
&nbsp;
<span class="TOKEN">Set</span> rngRange = <span class="TOKEN">Nothing</span>
Application.ScreenUpdating = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

Das dies Vorgehen kein Renner ist, kann ich verstehen. Vielleicht kannst Du auf der Basis ein schnelleres Tool aufbauen...</font>