vba Array abfragen

[Hans.Alborg]

Hallo,

<Excel 2007>

mir ist als ob ich sowas vor Jahren schon programmiert hatte, aber find
es nicht mehr...

Ein einfaches Array ist mit diversen Strings gefüllt (oder noch leer).

Ich möchte Text aus einigen Tabellen auslesen und in eine Sammeltabelle
eintragen, wobei jeder Text nur einmal erfaßt werden soll.

Meine Methode ist nun, erst die vorhandenen Einträge ins Array zu tun um
sie bei den Durchläufen auszuschließen.

Kommt ein weiterer String dazu wird wird der eingetragen und das Array
damit erweitert.

Dazu wäre es bequem, den Inhalt des Arrays ohne Schleife mit dem String
abzugleichen.

Gibt es sowas wie INSTR für Arrays?

TIA,

Hans

[Claus Busch]

Hallo Hans,

Am Tue, 10 Jan 2017 21:55:36 +0100 schrieb Hans.Alborg:

> Ich möchte Text aus einigen Tabellen auslesen und in eine Sammeltabelle
> eintragen, wobei jeder Text nur einmal erfaßt werden soll.
>
> Meine Methode ist nun, erst die vorhandenen Einträge ins Array zu tun um
> sie bei den Durchläufen auszuschließen.

lese alle Einträge in das Array und erstelle daraus ein Array ohne
Duplikate mit Scripting.Dictionary:

Sub Test()
Dim varData As Variant, varOut As Variant
Dim myDic As Object
Dim i As Long

'Erstelle hier dein Array varData
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varData) To UBound(varData)
myDic(varData(i)) = varData(i)
Next
varOut = myDic.items
'Schreibe dann das Array varOut in die Tabelle zurück
End Sub


Mit freundlichen Grüßen
Claus
--
Windows10
Office 2016

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:
> Hans.Alborg schrieb:

>
>> Meine Methode ist nun, erst die vorhandenen Einträge ins Array zu tun um
>> sie bei den Durchläufen auszuschließen.
>
> lese alle Einträge in das Array und erstelle daraus ein Array ohne
> Duplikate mit Scripting.Dictionary:

[...]

Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß ich
unterwegs im Code die gefundenen Strings als "hab ich schon" erkennen kann.
Dadurch kommen nur neue Strings zur Verarbeitung und dann in die
Sammeltabelle, was Doubles sowieso ausschließt.

Dazu möchte ich die gefundenen Strings mit dem Array- Inhalt vergleichen
(0/1 reicht ja).

...unter
http://www.vbarchiv.net/tipps/tipp_1650-isinarray-element-in-array-vorhanden.html

habe ich eine passende Funktion gefunden, was mir aber sagt, daß es
solche Bordmittel wohl nicht gibt, leider.

Aber eine Idee hab ich: kein Array, sondern einen superlangen String
bilden: dann geht INSTR.

Ich bekomme es hin daß alle Strings 7 Zeichen lang sind. Ein max-String
betrug 255 Zeichen?
Das reicht für 36 Strings. Mit 3 solchen Stringketten würde das dem
geplanten Datenumfang entsprechen.

Ich werde die IsInArray- Funktion (s.Link) trotzdem noch testen.
Performance und Aufwand, mal sehen...

Hans

[Claus Busch]

Hallo Hans,

Am Tue, 10 Jan 2017 22:39:00 +0100 schrieb Hans.Alborg:

> Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß ich
> unterwegs im Code die gefundenen Strings als "hab ich schon" erkennen kann.
> Dadurch kommen nur neue Strings zur Verarbeitung und dann in die
> Sammeltabelle, was Doubles sowieso ausschließt.

die doppelten Einträge mit Scripting.Dictionary zu entfernen ist die
schnellere Methode.

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

Hans.Alborg schrieb:
>

>> Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß ich
>> unterwegs im Code die gefundenen Strings als "hab ich schon" erkennen kann.
>> Dadurch kommen nur neue Strings zur Verarbeitung und dann in die
>> Sammeltabelle, was Doubles sowieso ausschließt.
>
> die doppelten Einträge mit Scripting.Dictionary zu entfernen ist die
> schnellere Methode.

Nein nein nein.

Ich suche den String X in vielen Tabellenblättern und in jeder in
mehreren Tabellen (nebeneinanderstehend).
Es gibt ihn mehrere Male!

Meine Abfrage:
Gibts String X im Array?

Nein!

Neben den Strings X sind Zeiten die ich addiere.
Stringname und Zeitsumme von X kommen in die Sammeltabelle.
Das Array bekommt String X als Inhalt.

Neuer Durchgang: String X wird wieder gefunden.

Jetzt wieder meine Abfrage:
Gibts String X im Array?

Ja!

Dann such weiter: String Y wird gefunden.

Weiter wie oben.

Eigentlich klassisch, bis auf die "wild" in den Tabellen verteilten
Einträge.
Läuft der Code (Sheets.Count) bis zum letzten Sheet durch wird beendet.

So kann nichts doppelt in die Sammeltabelle kommen.
Anfangs fülle ich das Array mit schon vorhandenen Einträgen, sodaß bei
einem neuen Durchlauf die Sammeltabelle nur fortgesetzt wird.

...leider war das in meinem Link kein VBA, und ich hab so den Verdacht,
daß die Funktion selbst eine Schleife darstellt.

Da kommt mir mein INSTR- Workaround garnicht mehr so schlecht vor.
Das braucht bei max. 100 Strings zwar vier Abfragen, aber keine Schleife!

Na der Morgen ist schlauer...

gute Nacht!

Hans

[Ulrich Möller]

Am 10.01.2017 um 22:39 schrieb Hans.Alborg:
> Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß
> ich unterwegs im Code die gefundenen Strings als "hab ich schon"
> erkennen kann.
> Dadurch kommen nur neue Strings zur Verarbeitung und dann in die
> Sammeltabelle, was Doubles sowieso ausschließt.

Geht prima mit einem Dictionary Objekt und einem kleinen Trick:

Erzeuge ein Dictionary Objekt und durch das alleinige Ansprechen eines
Elements über einen Key wird dieser Key neu angelegt, wenn er bis dahin
noch nicht vorhanden war. Das kann man sich zunutze machen.

Beispiel:

dim objDic as Object
dim vntTemp as Variant
dim avntUniqueKeys as Variant
set objDic = CreateObject(("scripting.dictionary")

und dann jeweils z.B. mit

vntTemp = objDic.Item("Sample_1")
vntTemp = objDic.Item("Sample_2")
vntTemp = objDic.Item("Sample_1") ' <--- hier wird keine weitere
Key angelegt!
objDic.item("Sample_3") = MeinWert ' <--- alternativ: Key mit einem
Wert anlegen

die Keys "Sample_1" , "Sample_2" und "Sample_3" anlegen. Dieses wären
die Strings, die du speichern möchtest.

avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller
unique Keys, also ein Array mit den Strings
und mit objDic.exists("Sample_1") kann abgefragt werden, ob ein Key
bereits existiert (ist aber hier nicht unbedingt notwendig).
Mit Debug.Print Join(objdic,keys, vbCrLf) kann man sich auch mal auf die
Schnelle alle Keys im Direktfenster ausgeben lassen.

Ulrich

[Hans.Alborg]

Hallo Claus,

> Hans.Alborg schrieb:

> Na der Morgen ist schlauer...

So isses. Ich hab erst garnicht gepeilt daß Deine Methode die doppelten
Strings schon beim durchsuchen vermeidet!
Das läuft auch sehr schnell durch.

Jetzt weiß ich aber nicht wie ich das mit den neben den Strings
stehenden Zeiten machen soll.
Kann ich das Array dafür benutzen? Dann müßte es wohl zweidimensional
sein, um jedem String seine Zeit zuordnen zu können.
Ich hab kein Beispiel für Arrays gefunden die in einer Dimension Strings
und in der anderen Singles o.a. haben.
Und die Zeiten der verworfenen Strings (weil schon im Array) sollen
aufaddiert werden und auf dem richtigen Platz im Array landen.

Das Auslesen von Strings und Zeiten ist dagegen wohl ziemlich einfach...

Hans

[Hans.Alborg]

Hi Ulrich,

Ulrich Möller schrieb:
> Hans.Alborg:
>> ...Dadurch kommen nur neue Strings zur Verarbeitung und dann in die

>> Sammeltabelle, was Doubles sowieso ausschließt.
>
> Geht prima mit einem Dictionary Objekt und einem kleinen Trick:
>
> Erzeuge ein Dictionary Objekt und durch das alleinige Ansprechen eines
> Elements über einen Key wird dieser Key neu angelegt, wenn er bis dahin
> noch nicht vorhanden war. Das kann man sich zunutze machen.

Das ist ein ganzes Stück über meinem Horizont. Du meinst mit Key
bestimmt ganz was anderes als SendKeys.

> Beispiel:
> ...

> set objDic = CreateObject(("scripting.dictionary")
>
> und dann jeweils z.B. mit
>
> vntTemp = objDic.Item("Sample_1")
> vntTemp = objDic.Item("Sample_2")
> vntTemp = objDic.Item("Sample_1") ' <--- hier wird keine weitere
> Key angelegt!
> objDic.item("Sample_3") = MeinWert ' <--- alternativ: Key mit einem
> Wert anlegen
>
> die Keys "Sample_1" , "Sample_2" und "Sample_3" anlegen. Dieses wären
> die Strings, die du speichern möchtest.
>
> avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller
> unique Keys, also ein Array mit den Strings

Aha! Also mit "scripting.dictionary" funktioniert ja auch Claus' Lösung
die ich erst mißverstanden hatte. Auch dort bekomme ich ein Array ohne
Doubles.

Nachdem ich so ein Array jetzt erzeugen kann beschäftigt mich, wie ich
neben den Strings stehende Zeiten (Single) zusammenzählen und dem
Arrayinhalt zuordnen kann.
Der erste String X wird ins Array aufgenommen, die weiteren "X" nicht.
Aber die Zeiten aller "X" müssen dann als Summe in der Sammeltabelle
neben "String X" stehen.
Mit "String Y" dann dasselbe usw.

Eignet sich ein mehrdimensionales Array dazu?

Hans

[Claus Busch]

Hallo Hans,

Am Wed, 11 Jan 2017 16:22:10 +0100 schrieb Hans.Alborg:

> Jetzt weiß ich aber nicht wie ich das mit den neben den Strings
> stehenden Zeiten machen soll.
> Kann ich das Array dafür benutzen? Dann müßte es wohl zweidimensional
> sein, um jedem String seine Zeit zuordnen zu können.
> Ich hab kein Beispiel für Arrays gefunden die in einer Dimension Strings
> und in der anderen Singles o.a. haben.
> Und die Zeiten der verworfenen Strings (weil schon im Array) sollen
> aufaddiert werden und auf dem richtigen Platz im Array landen.

beschreibe mal wo deine vorhandenen Strings mit den Zeiten stehen und
wie du in den Blättern nach den Strings suchst. Stehen die Zeiten immer
rechts vom String?

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> beschreibe mal wo deine vorhandenen Strings mit den Zeiten stehen und
> wie du in den Blättern nach den Strings suchst. Stehen die Zeiten immer
> rechts vom String?

So ist es.
Es gibt eine wachsende Zahl Sheets in der Mappe. Dort sind u.a.
3-spaltige Tabellen (max. 10 Stck) in verschiedener Länge (rund 40
Zeilen, der Kopf immer ab Zeile 10).
Die sind immer nebeneinander und durch eine Spalte getrennt.

-erste Spalte einer Tabelle verschiedene Texte (-->Aufträge)
-zweite Spalte eine Zeitdauer h:mm
-dritte Spalte eine Uhrzeit h:mm

Die Zellen Spalte 1-3 können auch leer sein.
Von den Textstrings interessieren mich solche, die hinten "123 456"
formatiert sind.

Wie geschrieben, in der Sammeltabelle keine doppelten Strings, aber
neben dem zugehörigen String die Summe der Zeitdauer aller gleichen Strings.

Verlauf:

Schleife /weggefallen:
Mehrere Durchläufe (einer pro neuem String)
- spart mit jetzt die Array-Technik:-)

Schleife:
Die Tabellenblätter werden mit Sheets.Count rückwärts durchsucht damit
der Code auf meinem aktuellen Blatt endet (ca. 1 Sheet/Woche).

1xSchleife Spalten, 1xSchleife Zeilen:
Ich kann die Spalten eines Blatts mit For-Next_Step 4 abklappern und die
Zeilen von unter dem Tabellenkopf (11) bis zu einer Zelle "Summe" (die
einzelnen Tabellen sind ja verschieden lang).
Oder gebe eine feste Länge vor, da das Suchkriterium "123 456" nicht
unter der Tabelle vorkommt.


Tja. Die Sammeltabelle baut sich im Moment unter der ersten
(String-)Tabelle des aktuellen Blatts auf und hat 2 Spalten.

-Erste Spalte: Name des Auftrags
-Zweite Spalte: verbrauchte Zeit (ja, muß [h]:mm werden).

Spalte 1 klappt schon und sehr schnell mit dem Array (naja, ist auch
noch früh im Jahr).

Hans

[Claus Busch]

Hallo Hans,

Am Wed, 11 Jan 2017 20:27:26 +0100 schrieb Hans.Alborg:

> Es gibt eine wachsende Zahl Sheets in der Mappe. Dort sind u.a.
> 3-spaltige Tabellen (max. 10 Stck) in verschiedener Länge (rund 40
> Zeilen, der Kopf immer ab Zeile 10).
> Die sind immer nebeneinander und durch eine Spalte getrennt.
>
> -erste Spalte einer Tabelle verschiedene Texte (-->Aufträge)
> -zweite Spalte eine Zeitdauer h:mm
> -dritte Spalte eine Uhrzeit h:mm
>
> Die Zellen Spalte 1-3 können auch leer sein.
> Von den Textstrings interessieren mich solche, die hinten "123 456"
> formatiert sind.

ich habe das jetzt mal nachgestellt. Für den Bereich mit den vorhandenen
Strings (ohne Überschrift) habe ich einen dynamischen Bereichsnamen
erstellt, damit sich dieser Bereich immer anpasst.
Der Code such auf allen Blättern nach "*123 456" und schreibt die
gefunden Einträge und die Dauer in ein 2D-Array.
Danach wird dieses Array durchlaufen. Wenn String schon vorhanden, wird
die Zeit addiert, wenn String nicht vorhanden wird String und Zeit
unterhalb eingefügt:

Sub Test()
Dim wsh As Worksheet
Dim varTmp() As Variant, varData As Variant
Dim i As Long, n As Long, LRow As Long
Dim c As Range
Dim FirstAddress As String, myStr As String

Application.ScreenUpdating = False
For Each wsh In Worksheets
With wsh
'Hier Suchbereich anpassen
Set c = .Range("A11:AK50").Find("*123 456", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ReDim Preserve varTmp(0 To 1, 0 To n)
varTmp(0, n) = c
varTmp(1, n) = c.Offset(, 1)
Set c = .Range("A11:AK50").FindNext(c)
n = n + 1
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next
varTmp = Application.Transpose(varTmp)

With Sheets(1)
For i = LBound(varTmp) To UBound(varTmp)
varData = .Range("Daten")
myStr = Join(Application.Index(Application.Transpose(varData), 1, 0), ",")
If InStr(myStr, varTmp(i, 1)) Then
Set c = .Range("Daten").Find(varTmp(i, 1))
c.Offset(, 1) = c.Offset(, 1) + varTmp(i, 2)
Else
LRow = .Cells(.Rows.Count, 1).End(xlUp)(2).Row
.Cells(LRow, 1) = varTmp(i, 1)
.Cells(LRow, 2) = varTmp(i, 2)
End If
Next
.Range("Daten").Offset(, 1).NumberFormat = "[h]:mm"
End With
Application.ScreenUpdating = True
End Sub

[Hans.Alborg]

Hallo Claus,

was machst Du wenn ich schlafe???

Claus Busch schrieb:

> Hans.Alborg:
>
>> ...interessieren mich solche, die hinten "123 456" formatiert sind.

die jedoch nicht "123 456" lauten müssen!

> ich habe das jetzt mal nachgestellt. Für den Bereich mit den vorhandenen
> Strings (ohne Überschrift) habe ich einen dynamischen Bereichsnamen
> erstellt, damit sich dieser Bereich immer anpasst.

Haben alle Blätter dann denselben Bereichsnamen? Ich habe bewußt auf
Namen verzichtet weil das aktuelle Blatt regelmäßig "nach hinten"
kopiert wird. Als "Blattname (1)"..."Blattname (50)" etwa.
Die Bereichsnamen würden wohl mitgenommen. Stört das?

> Der Code sucht auf allen Blättern nach "*123 456" und schreibt die

> gefunden Einträge und die Dauer in ein 2D-Array.

Wie oben angemerkt, ich habe nur das Format gemeint als Filter, nicht
"123 456" als Stringteil.

Inzwischen filtere ich so:

If Left(ws.Cells(i, j).Value, 2) = "IW" And _
IsNumeric(Right(ws.Cells(i, j).Value, 3)) Then

Also vorn "IW" und hinten 3 Ziffern.

> Danach wird dieses Array durchlaufen. Wenn String schon vorhanden, wird
> die Zeit addiert, wenn String nicht vorhanden wird String und Zeit
> unterhalb eingefügt:

> [Code]

Tja, genau das hatte ich im Sinn! Über den Tag heute, Kraft meiner
Wassersuppe habe ich auch eine Lösung gefunden: Erst das String- Array
füllen, und dann ein Zweites für die Zeiten. Das wird mit den Stellen
der Strings im ersten Array abgeglichen (Plätze identisch).
Erfordert leider zwei komplette Durchläufe.

So war das, bis es das erste Mal lief. Dann merkte ich, daß alle
Stringtabellen eine weitere Spalte brauchen: "Anzahl Mitwirkende".
Damit muß jede Zeit multipliziert werden ehe sie ins Array kommt.
Die Spalte kommt zwischen String und Zeit :-(

Jetzt baue ich alle Tabellen um und muß viel VBA anpassen (nicht nur das
hier behandelte).

Auf jeden Fall gefällt mir Dein Code viel besser als meiner. Ich werde
zwar meine Lösung erstmal anpassen damit's wieder läuft, aber dann
versuchen Deinen Vorschlag umzusetzen. Es wird ja weiterhin nur String
und Zeit eigesammelt.
Bei einigen Sachen (Join...) muß ich mich erst noch belesen...

Hans

[Claus Busch]

Hallo Hans,

Am Thu, 12 Jan 2017 16:59:35 +0100 schrieb Hans.Alborg:

> Haben alle Blätter dann denselben Bereichsnamen? Ich habe bewußt auf
> Namen verzichtet weil das aktuelle Blatt regelmäßig "nach hinten"
> kopiert wird. Als "Blattname (1)"..."Blattname (50)" etwa.
> Die Bereichsnamen würden wohl mitgenommen. Stört das?

nur die Ausgabe-Tabelle mit den schon vorhandenen Strings hat einen
dynamischen Bereichsnamen. Wenn ein String in dem Array gefunden wurde,
der noch nicht in diesem Bereich ist, wird er unten angehängt. Deswegen
der dynamische Namen, damit sich dieser Bereich automatisch anpasst und
der Gesamtstring der einzelnen Strings immer aktuell ist, wenn mit Instr
darin gesucht wird.

>> Der Code sucht auf allen Blättern nach "*123 456" und schreibt die
>> gefunden Einträge und die Dauer in ein 2D-Array.
>
> Wie oben angemerkt, ich habe nur das Format gemeint als Filter, nicht
> "123 456" als Stringteil.

der Code kommt ebenso mit "123 456" formatierten Zellen klar, da ja nach
dem angezeigten Zellinhalt gesucht wird.

[Claus Busch]

Hallo Hans,

Am Thu, 12 Jan 2017 16:59:35 +0100 schrieb Hans.Alborg:

>>> ...interessieren mich solche, die hinten "123 456" formatiert sind.
>
> die jedoch nicht "123 456" lauten müssen!

du kannst dann auch anstatt der Find-Methode die FindFormat-Methode
verwenden, aber mein Code geht auch mit anderem Inhalt, der aber @" 123
456" formtiert ist.

[Hans.Alborg]

Claus Busch schrieb:

> Hans.Alborg schrieb:
>

>>>> ...interessieren mich solche, die hinten "123 456" formatiert sind.
>>
>> die jedoch nicht "123 456" lauten müssen!
>
> du kannst dann auch anstatt der Find-Methode die FindFormat-Methode
> verwenden, aber mein Code geht auch mit anderem Inhalt, der aber @" 123
> 456" formtiert ist.

Es wird ein String gefunden der nach "123 456" noch Zeichen enthält
(kommt auch als erster). Den brauch' ich nicht.
Ich hatte dann mit...

If Not Left(c, 2) = "IW" Or _
Not IsNumeric(Right(c, 3)) Then c = Nothing

das weggefiltert, aber muß daran wohl noch werkeln, dann wurde im Blatt
nämlich nicht mehr weitergesucht.

Ich hab dann die erste Zeile der (noch leeren) Sammeltabelle (jetzt
besitzt sie 3 Spalten) mit dem Namen "Daten" versehen.

Wenn die Tabelle wächst, bleibt der Bereich "Daten" aber einzeilig.
Das ist evtl. der Grund, warum immer wieder derselbe String (bis auf 2x
ein anderer???) geschrieben wird, die Zeitspalte hat immer "00:00 Std.".

Auch die Suchrichtung werde ich auf Rückwärts umstellen, damit die
ältesten Daten zuerst in die Sammeltabelle kommen.

Na ich bastel weiter daran, morgen.

Mein eigener, längerer Code mit getrennten Arrays funktioniert
inzwischen mit dem Mitarbeiter-Faktor und somit ist die Tabelle erstmal
nutzbar.

Hans

[Claus Busch]

Hallo Hans,

Am Fri, 13 Jan 2017 23:04:58 +0100 schrieb Hans.Alborg:

> Es wird ein String gefunden der nach "123 456" noch Zeichen enthält
> (kommt auch als erster). Den brauch' ich nicht.

probiere es mal mit FindFormat:

Sub Test()

Dim varTmp() As Variant, varData As Variant

Dim i As Long, n As Long, LRow As Long, j As Long, k As Long
Dim c As Range, myRng As Range

Dim FirstAddress As String, myStr As String

Application.ScreenUpdating = False

With Application.FindFormat
.Clear
.NumberFormat = "@"" 123 456"""
End With

For j = Sheets.Count To 1 Step -1
With Sheets(j)
For k = 1 To 46 Step 5
'Hier Suchbereich anpassen
Set myRng = .Range(.Cells(11, k), .Cells(50, k))
Set c = myRng.Find("*", LookIn:=xlFormulas, searchformat:=True)

If Not c Is Nothing Then
FirstAddress = c.Address
Do

If Left(c, 2) = "IW" Then

ReDim Preserve varTmp(0 To 1, 0 To n)
varTmp(0, n) = c

varTmp(1, n) = c.Offset(, 1) * c.Offset(, 2)
Set c = myRng.FindNext(c)

n = n + 1

End If

Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

Next

End With
Next
varTmp = Application.Transpose(varTmp)

With Sheets(1)
For i = LBound(varTmp) To UBound(varTmp)
varData = .Range("Daten")
myStr = Join(Application.Index(Application.Transpose(varData), 1, 0), ",")
If InStr(myStr, varTmp(i, 1)) Then
Set c = .Range("Daten").Find(varTmp(i, 1))
c.Offset(, 1) = c.Offset(, 1) + varTmp(i, 2)
Else
LRow = .Cells(.Rows.Count, 1).End(xlUp)(2).Row
.Cells(LRow, 1) = varTmp(i, 1)
.Cells(LRow, 2) = varTmp(i, 2)
End If
Next
.Range("Daten").Offset(, 1).NumberFormat = "[h]:mm"
End With
Application.ScreenUpdating = True
End Sub

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:

> Hans.Alborg schrieb:
>

>> Es wird ein String gefunden der nach "123 456" noch Zeichen enthält
>> (kommt auch als erster). Den brauch' ich nicht.
>
> probiere es mal mit FindFormat:

> ...

> Application.ScreenUpdating = False
> With Application.FindFormat
> .Clear
> .NumberFormat = "@"" 123 456"""
> End With

.NumberFormat = "@"" 123 456"""

ergibt bei meinem Excel 2007 den Fehler 1004.
Evtl. versteht meine VBA-Version das nicht?

Nochmal zu dem Format der Strings:

"IW xxxxxx(Länge variabel)xxxxxx/123 456"

Das "IW" ist momentan nicht relevant. Aber für die Zukunft möchte ich
eine Wahlmöglichkeit auf die ersten 2 Zeichen vorsehen.

Der Schrägstrich sollte vorhanden sein, aber böse Menschen vergessen ihn
auch mal...
Die 6 Ziffern am Ende mit dem Leerzeichen in der Mitte sind das
eigentliche Kriterium. nach der Letzten Ziffer gibt es Strings wo noch
Buchstaben kommen: die will ich nicht finden.

Weiter zu Deinem Format-Beispiel:

Beim profanen
.NumberFormat = "h:mm"
als Test läuft der Code durch, es wird aber nichts gefunden (klar, in
"den" Suchspalten).
Daher ergibt sich bei

> varTmp = Application.Transpose(varTmp)

ein "Laufzeitfehler 5".
Den würde ich gerne abfangen (wenn auf "natürliche Weise" mal nichts
gefunden würde).
Tests mit "If .... Nothing" haben nicht geklappt.
Versuch mit "On Error" steht noch aus...

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 14 Jan 2017 07:13:29 +0100 schrieb Hans.Alborg:

> "IW xxxxxx(Länge variabel)xxxxxx/123 456"

ist 123 456 ein Teil des Strings oder wird dies durch ein Format
erzeugt?

[Hans.Alborg]

Claus Busch schrieb:

> Hans.Alborg schrieb:
>

>> "IW xxxxxx(Länge variabel)xxxxxx/123 456"
>
> ist 123 456 ein Teil des Strings oder wird dies durch ein Format
> erzeugt?

Das ist ein kompletter String, per Hand oder Copy eingegeben, in einer
Zelle. Format: Text.

Was mir am Ende des Codes noch auffiel: die Zeile mit .Offset und
"[h].mm" formatiert bei meiner jetzt 3-Spaltigen Sammeltabelle gleich
drei Spalten, da Offset wohl den Bereich "Daten" komplett versetzt.

Kann ich im Bereich eine Spalte wählen?

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 14 Jan 2017 10:46:56 +0100 schrieb Hans.Alborg:

> Das ist ein kompletter String, per Hand oder Copy eingegeben, in einer
> Zelle. Format: Text.
>
> Was mir am Ende des Codes noch auffiel: die Zeile mit .Offset und
> "[h].mm" formatiert bei meiner jetzt 3-Spaltigen Sammeltabelle gleich
> drei Spalten, da Offset wohl den Bereich "Daten" komplett versetzt.

auf welchem Blatt und in welchem Bereich ist die Ausgabe? Warum nun 3
Spalten? Du kannst doch bei einem Fund des Strings gleich die
Mitarbeiter und Zeit multiplizieren und mit nur das Gesamtergebnis in
die zweite Spalte des Arrays aufnehmen.

[Ulrich Möller]

Am 14.01.2017 um 07:13 schrieb Hans.Alborg:
> Nochmal zu dem Format der Strings:
>
> "IW xxxxxx(Länge variabel)xxxxxx/123 456"
>
> Das "IW" ist momentan nicht relevant. Aber für die Zukunft möchte ich
> eine Wahlmöglichkeit auf die ersten 2 Zeichen vorsehen.
>
> Der Schrägstrich sollte vorhanden sein, aber böse Menschen vergessen
> ihn auch mal...
> Die 6 Ziffern am Ende mit dem Leerzeichen in der Mitte sind das
> eigentliche Kriterium. nach der Letzten Ziffer gibt es Strings wo noch
> Buchstaben kommen: die will ich nicht finden.

Warum nicht einfach für den Stringsvergleich mit dem Like Operator von
vba arbeiten? Eine entsprechendes Muster müßte sich erstellen lassen.
Und wenn der Test damit positiv verläuft kann man den String
anschließend in seine Komponenten zerlegen.

Alternativ kann man beides in einem Rutsch (Test und Zerlegung) auch mit
RegEx machen.

Ulrich

[Hans.Alborg]

Claus Busch schrieb:

> Hans.Alborg schrieb:

>> Was mir am Ende des Codes noch auffiel: die Zeile mit .Offset und
>> "[h].mm" formatiert bei meiner jetzt 3-Spaltigen Sammeltabelle gleich
>> drei Spalten, da Offset wohl den Bereich "Daten" komplett versetzt.

> auf welchem Blatt und in welchem Bereich ist die Ausgabe?

Erstmal: alles fängt erst in Spalte "CJ" an, quasi neben dem Monitor...

Das aktuelle Arbeitsblatt reicht ca. 1 Woche. Ist die vorbei wird das
Blatt kopiert, heißt dann etwa "Name (1)" und ein "frisches" Sheet wird
erstellt (aus einer ausgeblendeten Vorlage). So verschiebt sich die
Ausgabe immer auf das aktuelle Blatt (ohne laufende Nummer im Namen).
Daher landet das älteste Blatt ganz am Ende von Worksheets.Count.
Also Suche rückwärts.

Die Ausgabetabelle entsteht also jede Woche neu im Blatt "Name" und wird
immer länger.
Der Stand Ende einer Woche findet sich dann auf dem entspr. Blatt "Name
(n)" weil die Ausgabetabelle mit abgespeichert wird.

> Warum nun 3 Spalten? Du kannst doch bei einem Fund des Strings gleich
die Mitarbeiter und Zeit multiplizieren und mit nur das Gesamtergebnis
in die zweite Spalte des Arrays aufnehmen.

Die "erste Stringtabelle" ist die wo Einträge stattfinden. Ist sie
fertig (Tag zuende) wird sie rechts abgespeichert: die "erste
Stringtabelle" kann inhaltlich gelöscht und wieder beschrieben werden.
Dann wieder Kopie nach der letzten genutzten Spalte+1.

Daher die Suche mit Step5.

Das Ende der "ersten Stringtabelle" ist übrigens dynamisch:
werden > 40 Zeilen benötigt werden Zeilen eingefügt.
In einem Fall muß eine Zeile eingefügt werden und abhängig von der Zahl
Gesamtzeilen eine leere Zeile weggenommen werden oder nicht.
Da am Ende der "ersten Stringtabelle" noch Summen gebildet werden u.ä.
kann ich das Erkennen der letzten genutzten Zelle nicht auf übliche
Weise durchführen.

So muß auch der Bereich "Daten" ein Stück tiefer "mitgehen".

Die Ausgabentabelle steht genau unter der "ersten Stringtabelle".
Dabei gibt es auch noch 2 Kopfzeilen. Nr.3 wäre dann die Zeile namens
"Daten", deren variable Größe ich noch nicht erlebt habe:-(

Drei Spalten braucht die Ausgabentabelle jetzt, weil Spalte 2 sich nach
oben orientiert wo "Anz." und "MA." im Kopf steht.
Das ist zu schmal für "22:00 Std." wie ich die Zeiten darstellen möchte.

Da "oben" in Spalte 3 die Zeitdauer mit gleicher Formatierung steht ist
es logisch, die Ausgabe der Zeiten unten auch in Spalte 3 zu tun.

Für die leere Ausgabespalte 2 schwebt mir schon vor, die Anzahl der
"Einsätze" einzutragen, also wie oft für einen Auftrag Hand angelegt
wurde. Das sind die Anzahl Treffer pro String.

Aber eins nach dem Anderen...

Hans

[Hans.Alborg]

Hi Ulrich,

Ulrich Möller schrieb:

> Hans.Alborg schrieb:

>> "IW xxxxxx(Länge variabel)xxxxxx/123 456"

> Warum nicht einfach für den Stringsvergleich mit dem Like Operator von
> vba arbeiten? Eine entsprechendes Muster müßte sich erstellen lassen.
> Und wenn der Test damit positiv verläuft kann man den String
> anschließend in seine Komponenten zerlegen.

Wie ich das verstanden hatte, ist die Suche im Blatt mit

Set c = myRng.Find("*", LookIn:=xlFormulas, searchformat:=True)

bereits erfolgt, und erst danach kann ich "c" untersuchen.
Verwerfe ich es, wird im Blatt nicht weitergesucht.

Das Problem ist daß "123 456" auch genommen wird wenn noch Zeichen folgen.

Habe ich erstmal den String "c" ist das Filtern kein Thema.

> Alternativ kann man beides in einem Rutsch (Test und Zerlegung) auch mit
> RegEx machen.

RegEx ist mir zu hoch! Aber "in einem Rutsch" beabsichtige ich garnicht.
Ich möchte ja mal später andere Startbuchstaben wählen statt "IW".

Also reicht "123 456" am Stringende zu finden.

Hans

[Ulrich Möller]

Hallo Hans,

ich glaube wir reden aneinander vorbei. Anscheinend möchtest du zwei
Vergleiche machen, um
1.) Die Stelle im Sheet zu finden, wo deine Informationen stehen und
dann 2.) der Vergleich, ob dort relevante Informationen stehen, die
ggf. ausgewertet werden müssen. Hierzu verwendest du eine Format um die
Zellen mit "12345" heraus zu filtern.

Wenn du den zu durchsuchenden Bereich doch kennst, warum durchsuchst du
dann nicht einfach diesen Bereich sequentiell und Vergleichst mit dem
Like-Operator und eine einer entsprechenden Maske, ob der Inhalt
relevant ist oder nicht:

Beispiel direkt aus der Excel Hilfe:

| For Each c In [A1:C5] If c.Font.Name Like "Cour*" Then c.Font.Name
= "Times New Roman" End If Next|

Wenn du jetzt die Range in dem Beispiel durch den zu durchsuchenden
Bereich ersetzt und den Vergleich anpasst, hast du doch genau das, was
du möchtest, oder sehe ich das falsch? Anstatt c.Font.Name könnte dort
auch z.B. c.Value stehen und wenn der Vergleich positiv ausfällt, kann
im then Zweig die Verarbeitung stattfinden

Auch hier glaube ich, liegt ein Missverständnis vor. Mit in "einem
Rutsch" meinte ich, den Vergleich und die Zerlegung des gefunden Strings
in einem Schritt mit RegEx durchzuführen. Das hat jetzt auch nichts mit
einer geplanten Erweiterung mit "IW" usw. zu tun, da das Suchmuster auch
jederzeit angepaßt werden kann. Ist aber sicherlich etwas komplexer, als
das o.a Beispiel.

Ulrich

[Hans.Alborg]

Ulrich Möller schrieb:

> ich glaube wir reden aneinander vorbei. Anscheinend möchtest du zwei
> Vergleiche machen

Naja, nach "IW" und die letzten 3(!) Zeichen auf Zahlen zu filtern war
der Anfang meiner Bemühungen, dann die Suche nach "### ###" am Stringende.
Dann kam mir die Idee, die "IW"- Abfrage für später zu behalten.
Aber soweit bin ich noch nicht.

> Wenn du den zu durchsuchenden Bereich doch kennst, warum durchsuchst du
> dann nicht einfach diesen Bereich sequentiell und Vergleichst mit dem
> Like-Operator und eine einer entsprechenden Maske, ob der Inhalt
> relevant ist oder nicht:
>
> Beispiel direkt aus der Excel Hilfe:
>
> | For Each c In [A1:C5] If c.Font.Name Like "Cour*" Then c.Font.Name
> = "Times New Roman" End If Next|

Unter "Each c In [A1:C5]" verstehe ich nicht sequentiell. Ich müßte
wenigstens nur jede 5. Spalte durchsuchen.

Was ist dann der Vorteil gegenüber LEFT$/RIGHT$ ?

Kann ich ein Union(Range... aus dem Suchbereich bilden und damit die
Suchschleife sparen? Was ist dann mit der Reihenfolge der Treffer?

> Wenn du jetzt die Range in dem Beispiel durch den zu durchsuchenden
> Bereich ersetzt und den Vergleich anpasst, hast du doch genau das, was
> du möchtest, oder sehe ich das falsch?

Naja, so läuft der Code schon durch. Ich suche mit

If c.Value Like "*### ###" Then

und VBA findtet was.
Ich werd weiter dran schrauben!

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 14 Jan 2017 07:13:29 +0100 schrieb Hans.Alborg:

> .NumberFormat = "@"" 123 456"""
> ergibt bei meinem Excel 2007 den Fehler 1004.
> Evtl. versteht meine VBA-Version das nicht?

du hattest mal geschrieben, dass die Strings hinten 123 456 formatiert
sind. Daher habe ich diesen Vorschlag gemacht.
Wenn deine Zellen Text-formatiert sind, dann probiere es mal mit
folgendem Code (da die anderen Spalten entweder Standard oder h:mm
formtiert sind, werden die dann nicht durchsucht und du musst keine
Schleife über die Spalten legen). Außerdem wird nun in der kompletten
Zelle gesucht und es werden dann keine Strings mehr gefunden, bei denen
hinter 123 456 noch etwas steht. Und IW aus in der Suche auch
inbegriffen:

With Application.FindFormat
.Clear
.NumberFormat = "@"

End With
n = 1

For j = Sheets.Count To 1 Step -1
With Sheets(j)

'Hier Suchbereich anpassen
Set myRng = .Range("A11:AT50")
Set c = myRng.Find("IW*123 456", LookIn:=xlFormulas,
lookat:=xlWhole, searchformat:=True)

If Not c Is Nothing Then
FirstAddress = c.Address
Do
If Left(c, 2) = "IW" Then

ReDim Preserve varTmp(1 To 2, 1 To n)
varTmp(1, n) = c
varTmp(2, n) = c.Offset(, 1) * c.Offset(, 2)

Set c = myRng.FindNext(c)
n = n + 1
End If
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

End With
Next
varTmp = Application.Transpose(varTmp)

[Claus Busch]

Hallo nochmals,

Am Sat, 14 Jan 2017 20:07:53 +0100 schrieb Claus Busch:

> If Left(c, 2) = "IW" Then

wird nicht mehr gebraucht. Also:

With Application.FindFormat
.Clear
.NumberFormat = "@"
End With
n = 1
For j = Sheets.Count To 1 Step -1
With Sheets(j)
'Hier Suchbereich anpassen
Set myRng = .Range("A11:AT50")
Set c = myRng.Find("IW*123 456", LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=True)
If Not c Is Nothing Then
FirstAddress = c.Address
Do

ReDim Preserve varTmp(1 To 2, 1 To n)
varTmp(1, n) = c
varTmp(2, n) = c.Offset(, 1) * c.Offset(, 2)
Set c = myRng.FindNext(c)
n = n + 1

[Ulrich Möller]

Hallo Hans,

Am 14.01.2017 um 18:45 schrieb Hans.Alborg:
> Ulrich Möller schrieb:
>
>> ich glaube wir reden aneinander vorbei. Anscheinend möchtest du zwei
>> Vergleiche machen
>
> Naja, nach "IW" und die letzten 3(!) Zeichen auf Zahlen zu filtern war
> der Anfang meiner Bemühungen, dann die Suche nach "### ###" am
> Stringende.
> Dann kam mir die Idee, die "IW"- Abfrage für später zu behalten.
> Aber soweit bin ich noch nicht.
>
>> Wenn du den zu durchsuchenden Bereich doch kennst, warum durchsuchst du
>> dann nicht einfach diesen Bereich sequentiell und Vergleichst mit dem
>> Like-Operator und eine einer entsprechenden Maske, ob der Inhalt
>> relevant ist oder nicht:
>>
>> Beispiel direkt aus der Excel Hilfe:
>>
>> | For Each c In [A1:C5] If c.Font.Name Like "Cour*" Then c.Font.Name
>> = "Times New Roman" End If Next|
>
> Unter "Each c In [A1:C5]" verstehe ich nicht sequentiell. Ich müßte
> wenigstens nur jede 5. Spalte durchsuchen.
>

"for each" bedeutet "für jedes Element in Elemente", d.h. jedes Element
in der Auflistung Elemente wird der Reihenfolge nach zurückgeliefert und
damit ist der Zugriff auch automatisch sequentiell in der Reihenfolge,
wie der Enumerator für die Auflistung programmiert ist. Auf nur jedes 5.
Element kann so nicht direkt zugegriffen werden. Das geht dann besser
mit einer for-next schleife mit step Argument.

> Was ist dann der Vorteil gegenüber LEFT$/RIGHT$ ?
>

Du kannst mit einem Muster arbeiten, z.B "IW*123456" liefert alles, was
mit IW beginnt und auf 123456 endet und "I[WV]*12345[67]" würde auf
alles passen, das mit IW oder IV beginnt und auf 123456 oder 1234567
endet. Mit left/right schon etwas aufwendiger. Der Preis ist eine etwas
längere Ausführungszeit als mit left/right. Muß man im Einzelfall für
sich ausmachen, welchem man hier den Vorzug gibt.

> Kann ich ein Union(Range... aus dem Suchbereich bilden und damit die
> Suchschleife sparen? Was ist dann mit der Reihenfolge der Treffer?
>

Ob eine Union auch so durchlaufen werden kann, habe ich noch nicht
probiert, kannst das aber ja mal mit deinen Testdaten verifizieren. Wenn
das ginge, wäre das natürlich optimal, weil dann die Anzahl der
Vergleiche reduziert werden könnte Die Reihenfolge selber wird durch den
Enumerator festgelegt, sollte aber eigentlich keine Rolle spielen, denn
Summenbildung ist ja nicht von der Reihenfolge abhängig. Das Ergebnis
sollte sowieso explizit an einer bestimmten Stelle hingeschrieben werden
und sortieren ist ja auch kein Problem.

>> Wenn du jetzt die Range in dem Beispiel durch den zu durchsuchenden
>> Bereich ersetzt und den Vergleich anpasst, hast du doch genau das, was
>> du möchtest, oder sehe ich das falsch?
>
> Naja, so läuft der Code schon durch. Ich suche mit
>
> If c.Value Like "*### ###" Then
>

genau das habe ich gemeint und hier kann auch ein komplizierteres Muster
zum Einsatz kommen. Idealerweise definiert man dann das Muster als
globale Konstante oder Variable und verwendet dann diese als Referenz

Public Const gstrMyPattern as String = "*123456"

if c.Value like gstrMyPatten then ...

Genaue Beispiele für die Muster findet man in der Hilfe->Visual Basic
Sprachverzeichnis->Operatoren->like.

> und VBA findtet was.
> Ich werd weiter dran schrauben!
>
> Hans
>

Ulrich

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> Set c = myRng.Find("IW*123 456", LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=True)

da wird leider nichts gefunden.
Wenn ich ein Stop setze und die Maus drüberhalte gibt das:
xlFormulas = -4123
xlWhole = 1

Wenn ich .Find("IW*", LookIn eintrage werden die IW- Strings gefunden.

Wenn ich .Find("*Wa", LookIn eintrage finden sich Strings mit dieser Endung.
Auch .Find("IW*Wa", LookIn funktioniert!

Wenn ich .Find("*456", LookIn oder gar .Find("*6", LookIn bzw.
.Find("*###", LookIn oder .Find("*#", LookIn eintrage wird nichts gefunden.

Es liegt also an den Zahlen!

Auf Ulrichs Vorschlag ist

For Each c In .Range("CJ11:DA50")

If c.Value Like "*### ###" Then

myStr = c.Value
End If
Next

entstanden. Da geht das mit den "#".

...hab grad nochmal geguckt ob Spaces an den Stringenden hängen. Das ist
nicht der Fall. Sollte ich aber noch abfangen wenn's mal läuft.

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 14 Jan 2017 23:18:15 +0100 schrieb Hans.Alborg:

> da wird leider nichts gefunden.
> Wenn ich ein Stop setze und die Maus drüberhalte gibt das:
> xlFormulas = -4123
> xlWhole = 1

bei mir funktioniert es korrekt.
Falls deine Strings doch nicht Text-formatiert sind, müsstest du
FindFormat auf das entsprechende Format einstellen.

> For Each c In .Range("CJ11:DA50")
> If c.Value Like "*### ###" Then
> myStr = c.Value
> End If
> Next

ist aber schon klar, dass bei deinem Datenbestand For Each C in Range
wesentlich langsamer ist als die Find-Methode

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> Hans.Alborg schrieb:

>
>> da wird leider nichts gefunden.
>

> bei mir funktioniert es korrekt.

Tja...

> Falls deine Strings doch nicht Text-formatiert sind, müsstest du
> FindFormat auf das entsprechende Format einstellen.

Die sind als Text formatiert (nicht Standard). Steht auch noch dabei:
"...behandeln auch Zahlen als Text..."
Die Ziffern am Enden werden nicht gefunden.

Kann man auch eingeben "IW*(ASCxy)" o.ä.?

>> For Each c In .Range("CJ11:DA50")

'neu Eingesetzt:
If myRng.Value Like "IW*### ###" Then
myStr = myRng.Value
>> End If
>> Next

Das klappt und ich setze

Set c = myRng

Die Zeile
'Set c = myRng.Find(...
hab ich auskommentiert da ja c schon belegt ist.
Komme aber dann bei

...
Set c = myRng.FindNext(c)

zu keinem Ergebnis, und

Loop While Not c Is Nothing And c.Address <> FirstAddress

ergibt eine Fehlermeldung weil c.Address nicht geht: c ist Nothing.

Ich seh jetzt zwei Optionen: Deinen Code behalten und hinter am Ende
jedes Strings mit Zahlen vorher ein Space zu generieren, oder halt
weiter meine For-Next Schleifen mit Abfrage Left$ und Right$ zu nehmen.
---
Ich hab Deinen Code in einer neuen Mappe laufen lassen.
Tabelle 1 ist Arbeitstabelle, Tb2 hat die Datentabellen und Tb3 ist leer.
Ich hab nur die Tabellen ab CJ8 (Pos.Kopf) gesetzt und auch die
Ausgabetabelle an CJ angepaßt.

Das bringt auch kein Erkennen bei

Set c = myRng.Find("IW*123 456", Lookin...

wohl aber bei

Set c = myRng.Find("IW*Wa", Lookin...

Ergo die gleiche Sache.

Ich kann in der Woche auf anderen Rechnern testen und evtl. auch ein
neueres Excel. Schaun mer ma.

Hans

[Michael Schwimmer]

Hallo

Am Tue, 10 Jan 2017 22:39:00 +0100 schrieb Hans.Alborg:

> Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß ich
> unterwegs im Code die gefundenen Strings als "hab ich schon" erkennen kann.

> Dadurch kommen nur neue Strings zur Verarbeitung und dann in die
> Sammeltabelle, was Doubles sowieso ausschließt.

ich verwende gerne Collections, wenn es um überschaubare Strings geht.
Um zu erkennen, ob der String schon existiert, ignorierst du einfach
Fehler, löschst den Fehlerspeicher und fügst den Wert als Element mit dem
String als Key ein. Ist die Fehlernummer ungleich Null, existiert der
String bereits. Der Nachteil ist, dass die Zeichenlänge begrenzt ist und
Groß/Kleinschreibung ignoriert wird.

Im Gegensatz zu Arrays können die Elementinhalte aber nicht geändert
werden, da benutze ich dann immer eine weitere Collection als
Wertcontainer, wie man im Code sieht.

Fügt man dem Wertcontainer noch eine weitere Collection hinzu,
beispielsweise mit dem Namen "Fundadressen", könnte man dort sogar alls
Fundadressen speichern und nachher in der Zielmappe ausgeben.

Wenn die Strings länger sind, müsste man mit einem Hash aus dem String als
Key arbeiten, das wäre dann wirklich eindeutig. So etwas würde die Sache
aber komplizierter machen.


Option Explicit
Sub test()
Dim Stringcontainer As Collection
Dim Wertcontainer As Collection
Dim i As Long
Dim Inhalt As Variant
Dim Wert As Variant
Dim Anzahl As Long

' Wichtig, Fehler ignorieren
On Error Resume Next

' Zufallsgenerator initialisieren
Randomize Timer

' Collection anlegen
Set Stringcontainer = New Collection

With Worksheets("Tabelle1")
For i = 1 To 100
If .Cells(i, 1) <> "" Then

Inhalt = CStr(.Cells(i, 1)) ' Inhalt als Schlüssel

' Neue Collection zur Aufnahme des Strings und des Wertes anlegen
Set Wertcontainer = New Collection

' Item "String" anlegen
Wertcontainer.Add Inhalt, "String"

Anzahl = 1
' Item "Anzahl" anlegen
Wertcontainer.Add Anzahl, "Anzahl"

Wert = 1 ' .Cells(i, 3)
' Item "Wert" anlegen
Wertcontainer.Add Wert, "Wert"


Err.Clear
' Zum Stringcontainer hinzufügen, Inhalt als Schlüssel
' Groß- Kleinschreibung wird nicht beachtet
Stringcontainer.Add Wertcontainer, Inhalt

If Err.Number <> 0 Then
' String bereits vorhanden

' Anzahl auslesen, erhöhen
Anzahl = Stringcontainer(Inhalt)("Anzahl") + 1
' Item "Anzahl" löschen
Stringcontainer(Inhalt).Remove ("Anzahl")
' Item "Anzahl" mit neuem Wert anlegen
Stringcontainer(Inhalt).Add Anzahl, "Anzahl"

' "Wert" auslesen, erhöhen
Wert = Stringcontainer(Inhalt)("Wert")
Wert = Wert + Int(Rnd(Now) * 100) ' .Cells(i, 2)
' Item "Wert" löschen
Stringcontainer(Inhalt).Remove ("Wert")
' Item "Wert" mit neuem Wert anlegen
Stringcontainer(Inhalt).Add Wert, "Wert"

Else
'String nicht vorhanden

End If

End If
Next
End With

' Fehlerbehandlung wieder ausschalten
On Error GoTo 0
i = 0
With Worksheets("Ausgabe")
For Each Inhalt In Stringcontainer
i = i + 1
.Cells(i, 1) = Inhalt("String")
.Cells(i, 2) = Inhalt("Anzahl")
.Cells(i, 3) = Inhalt("Wert")
Next
End With

End Sub


Viele Grüße

Michael

[Ulrich Möller]

Hallo Michael,

Am 18.01.2017 um 07:52 schrieb Michael Schwimmer:
> ich verwende gerne Collections, wenn es um überschaubare Strings geht.
> Um zu erkennen, ob der String schon existiert, ignorierst du einfach
> Fehler, löschst den Fehlerspeicher und fügst den Wert als Element mit dem
> String als Key ein. Ist die Fehlernummer ungleich Null, existiert der
> String bereits. Der Nachteil ist, dass die Zeichenlänge begrenzt ist und
> Groß/Kleinschreibung ignoriert wird.
>
> Im Gegensatz zu Arrays können die Elementinhalte aber nicht geändert
> werden, da benutze ich dann immer eine weitere Collection als
> Wertcontainer, wie man im Code sieht.
>
> Fügt man dem Wertcontainer noch eine weitere Collection hinzu,
> beispielsweise mit dem Namen "Fundadressen", könnte man dort sogar alls
> Fundadressen speichern und nachher in der Zielmappe ausgeben.
>
> Wenn die Strings länger sind, müsste man mit einem Hash aus dem String als
> Key arbeiten, das wäre dann wirklich eindeutig. So etwas würde die Sache
> aber komplizierter machen.

dann kann man auch gleich ein Dictionary Objekt nehmen und hat das o.a.
quasi schon mit an Bord, ohne das man eine Collection mit eigenen
Routinen erweitern muss. Das vereinfacht die Sache enorm.

Ulrich

[Michael Schwimmer]

Hallo,

Am Wed, 18 Jan 2017 11:35:30 +0100 schrieb Ulrich Möller:

> dann kann man auch gleich ein Dictionary Objekt nehmen und hat das o.a.
> quasi schon mit an Bord, ohne das man eine Collection mit eigenen
> Routinen erweitern muss. Das vereinfacht die Sache enorm.

klar, man kann auch fremde Objekte benutzen. Das Scripting-Objekt ist aber
in vielen Firmennetzwerken gar nicht verfügbar!

Was spricht denn dagegen, bei den Wurzeln zu bleiben, eben pures VBA? Dann
kommt man auch nicht ins Schleudern, wenn beispielsweise das (Application)
File-Search-Objekt ab einer bestimmten Version nicht mehr vorhanden ist.
Wer da zuvor Dir() und Co benutzt hatte, war eindeutig besser dran.

Und wenn man das zu "kompliziert" findet, kann man sich ja auch einmal eine
wiederverwertbare Klasse schreiben und das Ganze darin kapseln.

Viele Grüße

Michael

[Hans.Alborg]

Michael Schwimmer schrieb:
> Hallo
>
> Hans.Alborg schrieb:

>
>> Es geht mir nicht um das Schreiben in die Tabelle sondern darum, daß ich
>> unterwegs im Code die gefundenen Strings als "hab ich schon" erkennen kann.
>

> ich verwende gerne Collections, wenn es um überschaubare Strings geht.

> [...]

Interessanter Weg. Allerdings geht es jetzt vor allem darum daß dieser Code:
Set c = myRng.Find("IW*123 456", LookIn:= _
xlFormulas, lookat:=xlWhole, searchformat:=True)

bei Claus läuft, bei mir aber nicht.

"IW*123 456" ist der Knackpunkt. Ich möchte auf die Zahlen hinten
Filtern und das klappt nicht.

"IW*Wa"
solche Strings gibt es auch und die werden gefunden wenn ich die
Suchvorgabe "so" umbaue. Und
"IW*"
findet auch die Strings mit den Ziffern am Ende.

Aber ich wollte nur die! Meine Idee, denen ein SPACE anzuhängen
"IW* ")
bringt auch nichts ---> SPACE wird auch ignoriert!

Daher hab ich's jetzt so gemacht wie ich es verstehe: erst ein
kompletter Durchlauf um ein Array ohne Dubletten zu bekommen, dann ein
zweiter um weitere (2) Arrays zu bilden, wo die zugehörigen Daten
gesammelt und ggf. addiert werden, mit identischer Reihenfolge wie im
ersten Array.
Ich hab's leider noch nicht hinbekommen, die beiden Datenarrays
zusammenzufassen weil es schnell laufen mußte. Aber das tut es wenigstens.

Hier noch zum Amüsieren ein Screenshot von meiner Eisenbahnsimu:
wie mein Excel aus einer 111 eine 110 macht:

http://www.fotos-hochladen.net/view/kuriosum110zubjnou2lq98.png

Das Bild besteht aus mehreren Ausschnitten die die selektierte Zelle,
die Bearbeitungsleiste, den Zoom und die Schriftart zeigen.
Die Angabe "111" ist hier eine Spaltennummer.

Hans

[Ulrich Möller]

Hallo Michael,

Am 18.01.2017 um 14:29 schrieb Michael Schwimmer:
>> dann kann man auch gleich ein Dictionary Objekt nehmen und hat das o.a.
>> quasi schon mit an Bord, ohne das man eine Collection mit eigenen
>> Routinen erweitern muss. Das vereinfacht die Sache enorm.
> klar, man kann auch fremde Objekte benutzen. Das Scripting-Objekt ist aber
> in vielen Firmennetzwerken gar nicht verfügbar!

das Dictionary Objekt ist in etwa so fremd zu Office wie die Verwendung
des List-/TreeViews. Selbst in der Hilfe von Microsoft Office und deren
Anwendungen wird es ausdrücklich beschrieben.

Die Aussage, daß das Scripting Objekt in vielen Firmennetzen nicht
verfügbar ist, kann ich so nicht nachvollziehen. Selbst wenn der Windows
Scripting Host disabled ist, kann das Dictionary Objekt noch
instantiiert werden! Auf Grund der häufigen Verwendung in der Office
Automation würde das auch in vielen anderen Fällen Probleme machen.

Nebenbei: Nicht alle Anwendungen sind für Firmennetze gedacht bzw.
müssen deren Stabilitäts- und Sicherheitsansprüchen genügen und wenn
jemand professionell für Firmen Software für entwickelt, kennt derjenige
deren Ansprüche und Besonderheiten, die dort zu berücksichtigen sind.

> Was spricht denn dagegen, bei den Wurzeln zu bleiben, eben pures VBA? Dann
> kommt man auch nicht ins Schleudern, wenn beispielsweise das (Application)
> File-Search-Objekt ab einer bestimmten Version nicht mehr vorhanden ist.
> Wer da zuvor Dir() und Co benutzt hatte, war eindeutig besser dran.

Dann doch lieber gleich alles gleich mit API, oder? Aber wenn es eine
neue OS-Version gibt, stimmt dann das auch noch? ;-)
Aber im Ernst, der Dir() Aufruf ist nicht ohne und hat so seine Tücken,
besonders in Netzwerken. Andere vermeiden ihn wie die Pest, weil sie
nach sehr schwierig zu findenden Fehlern durch Seiteneffekte suchen mußten.

>
> Und wenn man das zu "kompliziert" findet, kann man sich ja auch einmal eine
> wiederverwertbare Klasse schreiben und das Ganze darin kapseln.

Klar ist eine typisierte Klasse die "sauberste" Lösung, aber nicht immer
hat man die Muße dazu oder die Zeit feht oder aber es lohnt sich der
Aufwand zum Nutzen nicht oder oder oder ...

Es ist auch ein bißchen Geschmackssache bzw. persönliche Freiheit bei
der Programmierung, wie man ein Problem angeht.

Grüße
Ulrich

[Ulrich Möller]

Hallo Hans,

Am 18.01.2017 um 18:31 schrieb Hans.Alborg:
> Interessanter Weg. Allerdings geht es jetzt vor allem darum daß dieser
> Code:
> Set c = myRng.Find("IW*123 456", LookIn:= _
> xlFormulas, lookat:=xlWhole, searchformat:=True)
>
> bei Claus läuft, bei mir aber nicht.
>
> "IW*123 456" ist der Knackpunkt. Ich möchte auf die Zahlen hinten
> Filtern und das klappt nicht.

rein interessehalber habe ich das mal bei mir getestet, und mit

----
SearchPattern = "IW*123456"

Set c = myRng.Find( _
What:=SearchPattern, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=True)

If Not c Is Nothing Then

first = c.Address
Do
Debug.Print c.Address, c.Value
Set c = sa.FindNext(c)
Loop While c.Address <> first
End If
---

bekomme ich mit Excel 2010 filtert genau die Zellen heraus, wie du es
beabsichtigst. Es werden nur die gefunden, die mit IW beginnen und auf
123456 enden.

Gruß
Ulrich

[Ulrich Möller]

Hier noch ein Link, der die Find Methode ganz gut erklärt:

http://www.tushar-mehta.com/publish_train/xl_vba_cases/1001%20range.find%20and%20findall.shtml#_The_Range.Find_method

Interessant ist auch noch, das die Find Methode zwischen zwei Aufrufen
Werte zwischenspeichert:

"The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved
each time you use this method. If you do not specify values for these
arguments the next time you call the method, the saved values are used.
Setting these arguments changes the settings in the Find dialog box, and
changing the settings in the Find dialog box changes the saved values
that are used if you omit the arguments. To avoid problems, set these
arguments explicitly each time you use this method."

Vielleicht hat das etwas mit deinem Problem zu tun?

Ulrich

[Klaus Summ]

Hallo

Am Wed, 18 Jan 2017 21:11:52 +0100 schrieb Ulrich Möller:

> Die Aussage, daß das Scripting Objekt in vielen Firmennetzen nicht
> verfügbar ist, kann ich so nicht nachvollziehen. Selbst wenn der Windows
> Scripting Host disabled ist, kann das Dictionary Objekt noch
> instantiiert werden! Auf Grund der häufigen Verwendung in der Office
> Automation würde das auch in vielen anderen Fällen Probleme machen.

wenn die scrrun.dll nicht da- oder nicht registriert ist, läuft da nichts
mehr.

>> Wer da zuvor Dir() und Co benutzt hatte, war eindeutig besser dran.
> Dann doch lieber gleich alles gleich mit API, oder? Aber wenn es eine
> neue OS-Version gibt, stimmt dann das auch noch? ;-)

Die Win-API ist wirklich toll und ich stehe unheimlich drauf. Ich habe auch
schon alles mögliche und scheinbar unmögliche damit gemacht.

Die Geschwindigkeit ist dabei zwar unschlagbar, es ist aber erheblich
schwieriger geworden, so etwas heutzutage für alle Versionen lauffähig zu
kriegen. Ohne bedingte Kompilierung mit unterschiedlichen Deklarationen und
Datentypen geht da wegen der verschiedenen Zeigerlängen 64 Bit vs 32 Bit
gar nichts mehr.

Und die Anzahl der Möglichkeiten, wie und unter welchen Umständen man seine
Anwendung abstürzen lassen möchte, sind damit erheblich gestiegen.

> Aber im Ernst, der Dir() Aufruf ist nicht ohne und hat so seine Tücken,
> besonders in Netzwerken. Andere vermeiden ihn wie die Pest, weil sie
> nach sehr schwierig zu findenden Fehlern durch Seiteneffekte suchen mußten.

Wenn man weiß, was man macht, klappt das vorzüglch. Dir() & Co ist übrigens
gar nicht so langsam, jedenfalls nicht langsamer als das FileSystem-Objekt.
Und das gilt auch, wenn umfangreiche Verzeichnisebenen durchsucht werden
müssen.

> Klar ist eine typisierte Klasse die "sauberste" Lösung, aber nicht immer
> hat man die Muße dazu oder die Zeit feht oder aber es lohnt sich der
> Aufwand zum Nutzen nicht oder oder oder ...
>
> Es ist auch ein bißchen Geschmackssache bzw. persönliche Freiheit bei
> der Programmierung, wie man ein Problem angeht.

Full ACK

Viele Grüße

Michael

[Michael Schwimmer]

Sorry,
ich habe im vorherigen Posting meinen alter ego benutzt, ist in manchen NGs
hilfreich, wenn man Meinungen vertritt, die nicht unbedingt dem Mainstream
entsprechen und man nicht unter Generalverdacht gestellt werden möchte, von
irgendwelchen Lobbygruppierungen gekauft zu sein.

Michael

[Hans.Alborg]

Hi Ulrich,

Ulrich Möller schrieb:

> "...To avoid problems..."

>
> Vielleicht hat das etwas mit deinem Problem zu tun?

My Problems are Languages where not be spoken in my Country;-)

Also: (Vorvorposting) suche ich nicht "123456" sondern Strings mit -egal
welchen- Ziffern am Ende. Die 6 Ziffern haben ein SPACE in der Mitte.
Ich könnte auch schon was mit der Prüfung der letzten drei Ziffern
anfangen, bin ja bescheiden.
Und die gesuchten (aber auch andere) Strings fangen mit "IW" an, später
möchte ich auch nach anderen Buchstabenpaaren filtern können.

Dein Vorschlag mit "LIKE" hat zwar geklappt, aber die Suche weiterer
Strings (.FindNext()) hab ich nicht geschafft.

Evtl. klappt das mit .Find nicht bei Excel 2007? Keiner von Euch
schreibt, mit welcher Version er testet...

Aber wie geschrieben: mit meinem eigenen ABC-Code läuft die Mappe.

Hans

[Claus Busch]

Hallo Hans,

Am Thu, 19 Jan 2017 16:50:02 +0100 schrieb Hans.Alborg:

> Also: (Vorvorposting) suche ich nicht "123456" sondern Strings mit -egal
> welchen- Ziffern am Ende. Die 6 Ziffern haben ein SPACE in der Mitte.
> Ich könnte auch schon was mit der Prüfung der letzten drei Ziffern
> anfangen, bin ja bescheiden.
> Und die gesuchten (aber auch andere) Strings fangen mit "IW" an, später
> möchte ich auch nach anderen Buchstabenpaaren filtern können.

falls du keine Strings hast die am Ende Buchstaben-Kombinationen aus 6
Buchstaben mit einem Leerzeichen in der Mitte haben (abc def) kannst du
so suchen:

Set c = myRng.Find("IW*??? ???", LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then

FirstAddress = c.Address
Do
ReDim Preserve varData(n)
'Hier anpassen, was in das Array geschrieben werden soll
varData(n) = c

n = n + 1

Set c = myRng.FindNext(c)

Loop While Not c Is Nothing And c.Address <> FirstAddress

End If

[Ulrich Möller]

Hallo Hans,

Am 19.01.2017 um 16:50 schrieb Hans.Alborg:
> Ulrich Möller schrieb:
>
>> "...To avoid problems..."
>>
>> Vielleicht hat das etwas mit deinem Problem zu tun?
>
> My Problems are Languages where not be spoken in my Country;-)
>

Leider habe ich keine Seite auf deutsch gefunden, die das genauso gut
beschreibt. Aber der Tenor ist im Prinzip, das die Parameter "LookIn,
LookAt, SearchOrder und MatchByte" vom Suchen Dialog in Excel
beeinflusst werden könnten und deshalb sollte man diese unbedingt immer
explizit angeben. Bei MatchByte bin ich mir aber nicht sicher.

> Also: (Vorvorposting) suche ich nicht "123456" sondern Strings mit
> -egal welchen- Ziffern am Ende. Die 6 Ziffern haben ein SPACE in der
> Mitte.

Sorry, hatte ich übersehen.

> Ich könnte auch schon was mit der Prüfung der letzten drei Ziffern
> anfangen, bin ja bescheiden.
> Und die gesuchten (aber auch andere) Strings fangen mit "IW" an,
> später möchte ich auch nach anderen Buchstabenpaaren filtern können.
>
> Dein Vorschlag mit "LIKE" hat zwar geklappt, aber die Suche weiterer
> Strings (.FindNext()) hab ich nicht geschafft.
>
> Evtl. klappt das mit .Find nicht bei Excel 2007? Keiner von Euch
> schreibt, mit welcher Version er testet...
>

Doch, hatte ich : Excel 2010 / Windows 8.1

> Aber wie geschrieben: mit meinem eigenen ABC-Code läuft die Mappe.

Also habe ich nochmals mit dem Space in der Mitte getestet, und alles
läuft wie es sollte. Da aber der Findbefehl keine Muster kennt, muß man
die drei Ziffern vor dem Space und nach dem Space in der Suchmaske
angeben. Dafür ist er aber schneller als ein for each.

Ich hatte in meinem Beispiel ein paar kleine Tippfehler, hier also
nochmal die beiden äquivalenten Methoden:

Sub FindTest()
Dim SearchPattern As String
Dim myRng As Range
Dim c As Range
Dim first As String
SearchPattern = "IW*123 456*"
Set myRng = Worksheets(1).Range("A1:D8")

Set c = myRng.Find( _
What:=SearchPattern, _
LookIn:=xlValues, _
LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

MatchCase:=True)
If Not c Is Nothing Then
first = c.Address
Do
Debug.Print c.Address, c.Value

Set c = myRng.FindNext(c)

Loop While c.Address <> first
End If

End Sub

Sub FindTest2()
Dim SearchPattern As String
Dim myRng As Range
Dim c As Range

' SearchPattern = "IW*### ###*"
SearchPattern = "IW*123 456*"
Set myRng = Worksheets(1).Range("A1:D8")
For Each c In myRng
If c.Value Like SearchPattern Then
Debug.Print c.Address, c.Value
End If
Next
End Sub

Man könnte ggf. auch find mit like kombinieren, z.B.
...
SearchPattern = "IW*??? ???*" ' für Find
SearchPattern2 = "IW*### ###*" ' für Like
...
Do
If c.Value Like SearchPattern2 Then
Debug.Print c.Address, c.Value
End If
Set c = myRng.FindNext(c)
Loop While c.Address <> first
...

Somit würde die Mustersuche mit Like nur auf die Zellen angewendet, die
mit Find grob "vorgefilter" wurden. Wenn es der Performance dient...

Ulrich

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> falls du keine Strings hast die am Ende Buchstaben-Kombinationen aus 6
> Buchstaben mit einem Leerzeichen in der Mitte haben (abc def) kannst du
> so suchen:
>
> Set c = myRng.Find("IW*??? ???", LookIn:=xlValues, lookat:=xlWhole)

> ...

Ja das ist eine Lösung des Problems. So bekomme ich Deinen Code mit dem
2D-Array ans laufen.

Allerdings kommen im unteren Codeteil jetzt Doubles vor
(na, läuft wohl das erte Mal soweit durch):

With Sheets(1)
For i = LBound(varTmp) To UBound(varTmp)
varData = .Range("Daten")
myStr = Join(Application.Index( _
Application.Transpose(varData), 1, 0), ",")
If InStr(myStr, varTmp(i, 1)) Then
Set c = .Range("Daten").Find(varTmp(i, 1))
c.Offset(, 1) = c.Offset(, 1) + varTmp(i, 2)
Else
LRow = .Cells(.Rows.Count, 87).End(xlUp)(2).Row
.Cells(LRow, 87) = varTmp(i, 1)
.Cells(LRow, 89) = varTmp(i, 2)
End If
Next
.Range("Daten").Offset(, 1).NumberFormat = "[h]:mm"
End With

Erst erfaßte mich der Geistesblitz, den Bereich "Daten" auf die erste
Stringspalte zu reduzieren, aber das war wohl falsch: bei
"mystr=join..." kam dann ein "Typen unverträglich"- Fehler.

Sollte sich der Bereich "Daten" nicht bei jedem Eintrag um eine Zeile
erweitern?
Das macht er nicht. Und ist wohl der Fehler!
Nur die erste Zeile der Ergebnistabelle heißt weiterhin "Daten".

Hier einfach mal die Ergebnistabelle der Testmappe:

IW SVA /007 468 34:18 30:06
IW FrqÜ /975 812 0,711111111
IW SIG-PZB /007 280 1,254166667
IW BU33,6 /006 872 0,780555556
IW SI-PZB /007 280 1,025
IW SI-PZB /007 280 0,895833333
IW EOW DS /988 073 0,979166667
IW Mrel /997 806 1,254166667
IW Mrel /997 806 1,020833333
IW SI-PZB /007 280 1,254166667
IW SI-PZB /007 280 0

Sie ist dreispaltig, durch:

.Range("Daten").Offset(, 1).[...]

(=vorletzte Zeile) werden falscherweise Spalte 2+3 zusammen formatiert
(34:18 und 30:06), was mich (wie o.erwähnt) auf die (falsche) Idee
brachte, der Bereich "Daten" müsse einspaltig sein.
Man sieht auch, daß sich "Daten" nicht erweitert: die Formatierung der
Zeit bleibt in der ersten Zeile.

Hans

[Hans.Alborg]

Hi Ulrich,

Ulrich Möller schrieb:

> Hans.Alborg schrieb:

>> My Problems are Languages where not be spoken in my Country;-)
>>
> Leider habe ich keine Seite auf deutsch gefunden,

Keine Bange, Dich mache ich doch dafür nicht verantwortlich, im
Gegenteil respektiere ich die Mühe, die Du und die anderen für mich
aufwendet!

> Aber der Tenor ist im Prinzip, das die Parameter "LookIn,
> LookAt, SearchOrder und MatchByte" vom Suchen Dialog in Excel
> beeinflusst werden könnten und deshalb sollte man diese unbedingt immer
> explizit angeben. Bei MatchByte bin ich mir aber nicht sicher.

Ja, nützt aber nichts:

> Set c = myRng.Find( _
> What:=SearchPattern, _
> LookIn:=xlValues, _
> LookAt:=xlWhole, _
> SearchOrder:=xlByRows, _
> MatchCase:=True)

ist genau was bei mir nicht geht. War denn Excel 2007 wirklich noch so
primitiv daß diese -ich sag mal: Brot-und-Butter-Befehle nicht laufen?

Die Idee von Claus, nicht nach Zahlen, sondern nach allen Zeichen zu
suchen unter Beachtung 3 Zeichen/SPACE/3 Zeichen (Maske "IW*??? ???")
klappt aber. Ich werde damit mal Deinen Code testen.

> Man könnte ggf. auch find mit like kombinieren, z.B.
> ...
> SearchPattern = "IW*??? ???*" ' für Find
> SearchPattern2 = "IW*### ###*" ' für Like
> ...
> Do
> If c.Value Like SearchPattern2 Then
> Debug.Print c.Address, c.Value
> End If
> Set c = myRng.FindNext(c)
> Loop While c.Address <> first
> ...

Ja sofern .Find klappt.

> Somit würde die Mustersuche mit Like nur auf die Zellen angewendet, die
> mit Find grob "vorgefilter" wurden. Wenn es der Performance dient...

Am Ende des Jahres gibt es etwa 50 Sheets mit je 7 Daten-Tabellen.
Dann fällt das auf:-)

Mal sehn was noch nötig ist um die Zeitwerte etc. jedes "gleichen"
Stringfunds zu addieren und zuzuordnen.

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 21 Jan 2017 07:46:48 +0100 schrieb Hans.Alborg:

> Erst erfaßte mich der Geistesblitz, den Bereich "Daten" auf die erste
> Stringspalte zu reduzieren, aber das war wohl falsch: bei
> "mystr=join..." kam dann ein "Typen unverträglich"- Fehler.

in meinem Beispiel ist der Bereich "Daten" nur die erste Spalte mit den
Strings und dieser Bereich wird durch den dynamischen Bereichsnamen
definiert. Daher erweitert er sich auch bei mir immer.Wenn er sich bei
dir nicht erweitert, ist wohl die Formel für "Bezieht sich auf" falsch.

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:

> Hans.Alborg schrieb:
>

>> Erst erfaßte mich der Geistesblitz, den Bereich "Daten" auf die erste Stringspalte zu reduzieren, aber das war wohl falsch...
>
> in meinem Beispiel ist der Bereich "Daten" nur die erste Spalte mit den Strings...

Na das hab ich ja (s.oben) getan, aber nur die erste Zelle.

> und dieser Bereich wird durch den dynamischen Bereichsnamen
> definiert. Daher erweitert er sich auch bei mir immer.Wenn er sich bei
> dir nicht erweitert, ist wohl die Formel für "Bezieht sich auf" falsch.

Hä Formel??? Ich merk schon auf was für einem Dampfer ich bin.

Ich markiere den Bereich/ Rechtsklichmenü/ Bereich benennen. Dort steht
der markierte Teil dann als "bezieht sich auf".

Jo, auf die Art hab ich jetzt 200 Zeilen markiert und es sieht gleich
mal viel besser aus.

Dann vertell mir doch bitte wie Du das mit den "dynamischen
Bereichsnamen" genau machst im Gegensatz zu meinen Statischen...

Hans

[Claus Busch]

Hallo Hans,

Am Sat, 21 Jan 2017 10:22:50 +0100 schrieb Hans.Alborg:

> Hä Formel??? Ich merk schon auf was für einem Dampfer ich bin.

angenommen, dein Bereich fängt im Moment in CI50 an. Falls Zeilen
oberhalb eingefügt werden, passt sich die Ausgangszelle an.
Dann vergeben den Namen Daten und schreibe bei "Bezieht sich auf":

=BEREICH.VERSCHIEBEN(Tabelle1!$CI$50;;;ANZAHL2(Tabelle1!$CI$50:$CI$10000))

Nun kannst du auch noch einen Namen "Zeiten" vergeben und gebe für
diesen folgende Formel ein:

=BEREICH.VERSCHIEBEN(Daten;;1;;2)

Dann kannst du die Formatierung auch fehlerfrei durchführen mit

Range("Zeiten").NumberFormat ="[h]:mm"

[Claus Busch]

Hallo nochmals.

Am Sat, 21 Jan 2017 10:34:33 +0100 schrieb Claus Busch:

> =BEREICH.VERSCHIEBEN(Tabelle1!$CI$50;;;ANZAHL2(Tabelle1!$CI$50:$CI$10000))

den Tabellennamen musst du nicht in die Formel eingeben, der passt sich
von alleine an.

[Claus Busch]

Hallo Hans,

Am Sat, 21 Jan 2017 10:22:50 +0100 schrieb Hans.Alborg:

> Dann vertell mir doch bitte wie Du das mit den "dynamischen
> Bereichsnamen" genau machst im Gegensatz zu meinen Statischen...

Hier nochmal Code, der auch berücksichtigt, wenn CI50 (also die
Ausgangszelle des Bereichs "Daten") noch leer sein sollte.
Die Suchbereiche musst du noch entsprechend anpassen:

Sub Test()
Dim myRng As Range, c As Range, dest As Range
Dim i As Long, n As Long
Dim FirstAddress As String, myStr As String
Dim varTmp() As Variant, varData As Variant


For i = Sheets.Count To 1 Step -1
With Sheets(i)
Set myRng = .Range("A11:Z50")

Set c = myRng.Find("IW*??? ???", LookIn:=xlValues, lookat:=xlWhole)

n = 1

If Not c Is Nothing Then
FirstAddress = c.Address
Do

ReDim Preserve varTmp(1 To 2, 1 To n)
varTmp(1, n) = c
varTmp(2, n) = c.Offset(, 1) * c.Offset(, 2)

n = n + 1
Set c = myRng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

varTmp = Application.Transpose(varTmp)
End With
Next

With Sheets(1)
For n = LBound(varTmp) To UBound(varTmp)
If Len(.Range("CI50")) = 0 Then
.Range("CI50") = varTmp(n, 1)
.Range("CJ50") = varTmp(n, 2)
Else

varData = .Range("Daten")

If IsArray(varData) Then
myStr = Join(Application.Index(Application.Transpose(varData), 1, 0), ",")
Else
myStr = varData
End If
If InStr(myStr, varTmp(n, 1)) Then
Set c = .Range("Daten").Find(varTmp(n, 1))
c.Offset(, 1) = c.Offset(, 1) + varTmp(n, 2)
Else
Set dest = .Cells(.Rows.Count, 87).End(xlUp)(2)
dest = varTmp(n, 1)
dest.Offset(, 1) = varTmp(n, 2)

End If
End If
Next

.Range("Zeiten").NumberFormat = "[h]:mm"
End With

End Sub

[Ulrich Möller]

Hallo Hans,

Am 11.01.2017 um 16:39 schrieb Hans.Alborg:
> Ulrich Möller schrieb:

>> Hans.Alborg:
>>> ...Dadurch kommen nur neue Strings zur Verarbeitung und dann in die

>>> Sammeltabelle, was Doubles sowieso ausschließt.
>>

>> Geht prima mit einem Dictionary Objekt und einem kleinen Trick:
>>
>> Erzeuge ein Dictionary Objekt und durch das alleinige Ansprechen eines
>> Elements über einen Key wird dieser Key neu angelegt, wenn er bis dahin
>> noch nicht vorhanden war. Das kann man sich zunutze machen.
>
> Das ist ein ganzes Stück über meinem Horizont. Du meinst mit Key
> bestimmt ganz was anderes als SendKeys.
>
>> Beispiel:
>> ...
>> set objDic = CreateObject(("scripting.dictionary")
>>
>> und dann jeweils z.B. mit
>>
>> vntTemp = objDic.Item("Sample_1")
>> vntTemp = objDic.Item("Sample_2")
>> vntTemp = objDic.Item("Sample_1") ' <--- hier wird keine weitere
>> Key angelegt!
>> objDic.item("Sample_3") = MeinWert ' <--- alternativ: Key mit einem
>> Wert anlegen
>>
>> die Keys "Sample_1" , "Sample_2" und "Sample_3" anlegen. Dieses wären
>> die Strings, die du speichern möchtest.
>>
>> avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller
>> unique Keys, also ein Array mit den Strings
>
> Aha! Also mit "scripting.dictionary" funktioniert ja auch Claus'
> Lösung die ich erst mißverstanden hatte. Auch dort bekomme ich ein
> Array ohne Doubles.
>
> Nachdem ich so ein Array jetzt erzeugen kann beschäftigt mich, wie ich
> neben den Strings stehende Zeiten (Single) zusammenzählen und dem
> Arrayinhalt zuordnen kann.
> Der erste String X wird ins Array aufgenommen, die weiteren "X" nicht.
> Aber die Zeiten aller "X" müssen dann als Summe in der Sammeltabelle
> neben "String X" stehen.
> Mit "String Y" dann dasselbe usw.
>
> Eignet sich ein mehrdimensionales Array dazu?
ich habe mal ein kleines Beispiel gemacht, wie du mit einem Dictionary
Objekt deine Strings und die akkumulierten Zeiten verwalten könntest:

in eine Modul:

Private m_dicUniqueStorage As Scripting.Dictionary

Public Property Get Store() As Scripting.Dictionary
If m_dicUniqueStorage Is Nothing Then
Set m_dicUniqueStorage = CreateObject("Scripting.Dictionary")
End If

Set Store = m_dicUniqueStorage
End Property

Public Sub ClearStorage()
Store.RemoveAll
End Sub

Public Sub AddToSore(ByRef KeyValuePair() As Variant)
Dim vntValue As Variant

If Store.Exists(KeyValuePair(0)) Then
' Akkumulieren
vntValue = Store.Item(KeyValuePair(0))
Store.Item(KeyValuePair(0)) = vntValue + KeyValuePair(1)
Else
' Neuen Eintrag anfügen
Store.Add KeyValuePair(0), KeyValuePair(1)
End If
End Sub

Hier ein Beispielaufruf, mit dem das Dictionary Objekt gefüllt wird,
wobei in diesem Testfall der zu akkumulierende Wert einfach rechts neben
dem String steht.

Public Sub AkkumulateTimeValues(ByVal DataArea As Range)
Dim c As Range
Dim vntKeyValue(1) As Variant
' (0) - StringValue/Key
' (1) - Timevalue in Minutes

ClearStorage

For Each c In DataArea
vntKeyValue(0) = c.Value
vntKeyValue(1) = c.Offset(ColumnOffset:=1).Value

AddToSore vntKeyValue
Next
End Sub

Der Zugriff auf das Dictionary erfolgt dann mit
Store.Keys - gibt ein Array der eindeutigen Strings zurück
Store.Items - gibt ein Array aller akkumulierten Werte
zurück.
Store("TestStringXX") - gibt den akkumulierten Wert für den
Stringtext "TestStringXX" zurück

und mit Clearstore() oder Store.RemoveAll werden alle Einträge gelöscht.


Meine Testroutine war dann einfach:

Private Sub cmdAction_Click()
Dim rngOut As Range
Dim avnt As Variant

AkkumulateTimeValues Me.Range("TestStrings") - benannter Bereich mit
den Stringtexten und Minuten

' Testoutput
avnt = Store.Items
Set rngOut = Me.Range("C2")
Set rngOut = rngOut.Resize(Store.Count, 1)
rngOut.Value = Application.Transpose(avnt)
End Sub

Natürlich könnte man das auch nach Bedarf erweitern. Bei Interesse kann
ich das Projekt auch hochladen.

Grüße
Ulrich

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:
> Hans.Alborg schrieb:
>

>> Dann vertell mir doch bitte wie Du das mit den "dynamischen
>> Bereichsnamen" genau machst im Gegensatz zu meinen Statischen...

Was ich noch klären muß: was passiert mit den Bereichsnamen wenn das
Blatt kopiert wird und ein Neues entsteht? Jedes Blatt hätte dann
dieselben Bereichsnamen, der Bereich mal größer, mal kleiner.
Ich glaub aber bei Deinem Code bezieht sich alles nur auf das
Ausgabeblatt, d.h. Bereiche mit gleichem Namen auf anderen Blättern sind
egal.

> Hier nochmal Code, der auch berücksichtigt, wenn CI50 (also die
> Ausgangszelle des Bereichs "Daten") noch leer sein sollte.

Ja das ist gut weil ich die Ergebnistabelle vor Erstellen wohl immer
löschen werde.

> Sub Test()
> Dim ...

>
> For i = Sheets.Count To 1 Step -1
> With Sheets(i)
> Set myRng = .Range("A11:Z50")
> Set c = myRng.Find("IW*??? ???", LookIn:=xlValues, lookat:=xlWhole)
> n = 1

Der Zähler n gehört wohl am Anfang auf 1, nicht bei jedem Blatt wieder.

> If Not c Is Nothing Then
> FirstAddress = c.Address
> Do
> ReDim Preserve varTmp(1 To 2, 1 To n)
> varTmp(1, n) = c
> varTmp(2, n) = c.Offset(, 1) * c.Offset(, 2)
> n = n + 1
> Set c = myRng.FindNext(c)
> Loop While Not c Is Nothing And c.Address <> FirstAddress
> End If
> varTmp = Application.Transpose(varTmp)

und obige Zeile hab ich wieder unter das NEXT versetzt.

> End With
> Next
>
> With Sheets(1)

>...

> Else
> varData = .Range("Daten")
> If IsArray(varData) Then
> myStr = Join(Application.Index(Application.Transpose(varData), 1, 0), ",")

Ist das ratsam? myStr wird immer länger. War da nicht eine Grenze für
die Stringlänge? Am Jahresende schätze ich grob, kommen 2000 Zeichen
zueinander.

> Else
> ...

Sonst sieht alles gut aus. Ich muß aber noch von der Testmappe auf die
richtige wechseln.

Hans

[Claus Busch]

Hallo Hans,

Am Sun, 22 Jan 2017 09:46:22 +0100 schrieb Hans.Alborg:

> Was ich noch klären muß: was passiert mit den Bereichsnamen wenn das
> Blatt kopiert wird und ein Neues entsteht? Jedes Blatt hätte dann
> dieselben Bereichsnamen, der Bereich mal größer, mal kleiner.
> Ich glaub aber bei Deinem Code bezieht sich alles nur auf das
> Ausgabeblatt, d.h. Bereiche mit gleichem Namen auf anderen Blättern sind
> egal.

ich weiß immer noch nicht richtig wie deine Mappe aufgebaut ist und was
du wirklich bezweckst.
Bisher habe ich es so verstanden, dass die Zusammenfassung aller
gefundenen Strings und ihrer Zeiten nur auf das erste Blatt geschrieben
wird. Und nur für dieses erste Blatt und den dafür vorgesehenen
Ausgabebereich sind diese Namen definiert. Die Suchbereiche in den
Blättern kenne ich nicht und weiß auch nicht wie diese sich über die
Zeit verändern. In meinem Code habe ich diese bisher fest referenziert
mit A11:Z50.
Ich habe dir mal eine Mail geschickt zu meiner Demo-Mappe. Dort sind nur
zwei Tabellenblätter drin mit jeweils nur einer Tabelle. Die Fundstellen
sind hellblau markiert. Schau mal auf Tabelle1 Bereich CI50:CJ50. Dort
werden die gefundenen Strings und die Zeiten ausgegeben. Wie die Namen
definiert sind, findest du im Namensmanager.

[Hans.Alborg]

Hi Ulrich,

Ulrich Möller schrieb:

>> Ulrich Möller schrieb:

>>> avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller
>>> unique Keys, also ein Array mit den Strings

Mmh, Key wollte mein Excel als Variable deklariert sehen...

> ich habe mal ein kleines Beispiel gemacht, wie du mit einem Dictionary
> Objekt deine Strings und die akkumulierten Zeiten verwalten könntest:
>
> in eine Modul:

> [...]

> Natürlich könnte man das auch nach Bedarf erweitern. Bei Interesse kann
> ich das Projekt auch hochladen.

Der Ablauf wird sich bestimmt noch ändern. Die zu addierenden Zeiten
sind ja inzwischen auf die übernächste Spalte gerückt, die nächtste zum
Suchstring enthält die Zahl der Mitarbeiter (1..4, die mit den Zeiten
noch multipliziert wird), die Zahl der Einsätze pro Auftrag (Suchstring)
ergibt sich aus der Summe der Treffer pro String und letztlich wird die
"akkumulierte" Zeit von der Gesamtzeit für den Auftrag abgezogen (bisher
nur angezeigt) um zu sehen was noch übrig bleibt.
Schick für später wäre dann ein Hinweis, welche Blätter den Suchstring
enthalten (wg. Spaltenknappheit als Kommentar, Combobox o.ä.)...

Ich werde mich erstmal mit Deinem Code beschäftigen. Wenn ich und mein
Excel 2007 es schaffen den Code ans Laufen zu bringen melde ich mich.

Hans

[Ulrich Möller]

Am 22.01.2017 um 10:21 schrieb Hans.Alborg:
> Ulrich Möller schrieb:
>
>>> Ulrich Möller schrieb:
>
>>>> avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller

hier sollte ein Punkt anstatt eines Kommas stehen, das Keys eine Methode
vom Dictionary ist:

avntUniqueKeys = objDic.keys

>>>> unique Keys, also ein Array mit den Strings
>
> Mmh, Key wollte mein Excel als Variable deklariert sehen...
>

Ulrich

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:
> Hans.Alborg schrieb:

>> Ich glaub aber bei Deinem Code bezieht sich alles nur auf das
>> Ausgabeblatt, d.h. Bereiche mit gleichem Namen auf anderen Blättern sind
>> egal.

> ich weiß immer noch nicht richtig wie deine Mappe aufgebaut ist und was
> du wirklich bezweckst.

> Ich habe dir mal eine Mail geschickt zu meiner Demo-Mappe. Dort sind nur
> zwei Tabellenblätter drin mit jeweils nur einer Tabelle. Die Fundstellen
> sind hellblau markiert. Schau mal auf Tabelle1 Bereich CI50:CJ50. Dort
> werden die gefundenen Strings und die Zeiten ausgegeben. Wie die Namen
> definiert sind, findest du im Namensmanager.

Ok. Eine Erklärung wie alles funktioniert, wo die Bereiche liegen etc.
läßt sich nicht so kurz abfassen, evtl. schreib ich Dir das dann per PM
zurück.

Dein Code läuft ja schon und ich hab nur noch Bedenken wegen des langen
Strings.
Die Bereichsnamen kann ich sicher mit VBA vergeben und auch löschen,
sodaß sie woanders nicht mehr auftauchen/stören.

Wenn sich die Länge der ersten Stringtabelle ändert, unter der die
Ergebnistabelle liegt, ist es warscheinlich sowieso geraten, die
Namensbereiche zu löschen und neu zu setzen.

Aber: Deine Mail ist bis jetzt noch unterwegs...

Hans

[Claus Busch]

Hallo Hans,

Am Sun, 22 Jan 2017 11:33:35 +0100 schrieb Hans.Alborg:

> Aber: Deine Mail ist bis jetzt noch unterwegs...

dann lade dir mal die Mappe von hier herunter:
https://1drv.ms/x/s!AqMiGBK2qniTgYgnUKyj1N9pA11e_w

[Ulrich Möller]

Am 22.01.2017 um 10:21 schrieb Hans.Alborg:

> Hi Ulrich,
>
> Ulrich Möller schrieb:
>
>>> Ulrich Möller schrieb:
>
>>>> avntUniqueKeys = objDic,keys liefert dann ein Variant-Array aller
>>>> unique Keys, also ein Array mit den Strings
>
> Mmh, Key wollte mein Excel als Variable deklariert sehen...
>
>> ich habe mal ein kleines Beispiel gemacht, wie du mit einem Dictionary
>> Objekt deine Strings und die akkumulierten Zeiten verwalten könntest:
>>
>> in eine Modul:
>> [...]
>
>> Natürlich könnte man das auch nach Bedarf erweitern. Bei Interesse kann
>> ich das Projekt auch hochladen.
>
> Der Ablauf wird sich bestimmt noch ändern. Die zu addierenden Zeiten
> sind ja inzwischen auf die übernächste Spalte gerückt, die nächtste
> zum Suchstring enthält die Zahl der Mitarbeiter (1..4, die mit den
> Zeiten noch multipliziert wird), die Zahl der Einsätze pro Auftrag
> (Suchstring) ergibt sich aus der Summe der Treffer pro String und
> letztlich wird die "akkumulierte" Zeit von der Gesamtzeit für den
> Auftrag abgezogen (bisher nur angezeigt) um zu sehen was noch übrig
> bleibt.
> Schick für später wäre dann ein Hinweis, welche Blätter den Suchstring
> enthalten (wg. Spaltenknappheit als Kommentar, Combobox o.ä.)...
>

Der Trick ist, an die Funktion AddToStore ein Variant-Array zu
übergeben, welches dann entsprechend zerlegt wird. Dabei wird einfach
das erste Element als Key festgelegt, mit dem alles verwaltet wird, und
dann das übergebene Variant-Array im Dictionary abgespeichert. Wieviele
Information dieses Array enthält. ist eigentlich egal. Anschließend
müssen dann noch die Verarbeitungsroutinen, wie z.B. Summenbildungen
usw. angepaßt werden. Beim Auslesen bekommt man dann ein Array-of-Array
zurück, wo man sich dann die gewünschten Element herauspicken muß. Wenn
man nur immer auf bestimmte Elemente im Array-of-Array zugreifen möchte,
würde man diese Funktionalität einmal im Modul UniqueStore als Property
ausprogrammieren.

> Ich werde mich erstmal mit Deinem Code beschäftigen. Wenn ich und mein
> Excel 2007 es schaffen den Code ans Laufen zu bringen melde ich mich.
>

Ulrich

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> https://1drv.ms/x/s!AqMiGBK2qniTgYgnUKyj1N9pA11e_w

Vielen Dank für die Mühe. Ich hab mit die Mappe mal geladen, um mir das
genauer anzusehen. Ist leider wie bei mir, daß ich die Namensbereiche
nicht mehr direkt im Adressfenster sehen kann wenn die Formel drinsteht.

In der Beispieltabelle hast Du die Spalten Zeit und Mitarbeiter
andersherum wie ich. Daher hab ich mich mit dem Code wohl öfters verheddert.

Wenn Du 2 Trefferzeilen blau markierst sollten auch nur 2 Zeilen in der
ErgebnisTabelle auftauchen.

Es stehen aber Strings im Ergebnis die der Code scheinbar aus versch.
Teilen zusammengesetzt hat. Die gibt es so nicht.

Sonst läuft der Code so durch wie bei mir (hab auch noch ein
Spaltenproblem in den Ergebnissen). Jetzt muß ich selbst mal gucken ob
ich zusammengesetzte Strings habe:-(

Wegen der Stringlänge werde ich einfach mal 50 Blatter mit je 10
Stringtabellen produzieren in der Testmappe. Dauert.

Hans

[Claus Busch]

Hallo Hans,

Am Sun, 22 Jan 2017 14:50:43 +0100 schrieb Hans.Alborg:

> Wenn Du 2 Trefferzeilen blau markierst sollten auch nur 2 Zeilen in der
> ErgebnisTabelle auftauchen.

ich dachte, dass alle Treffer der Mappe in einer einzigen Tabelle
aufgelistet würden. Im Moment ist es so, dass in beiden Tabellen
zusammen 5 Treffer sind. Davon sind zwei identisch und werden somit
addiert und du bekommst 4 Einträge.

> Wegen der Stringlänge werde ich einfach mal 50 Blatter mit je 10
> Stringtabellen produzieren in der Testmappe. Dauert.

Du musst auch nicht unbedingt den Ausgabebereich in einen String wandeln
und dann im Instr überprüfen. Es gäbe auch die Möglichkeit mit der
Find-Methode den Ausgabebereich zu durchsuchen. Bei Fund addieren der
Werte, bei Fehlen unten anfügen.

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:

> Hans.Alborg schrieb:

>> Wenn Du 2 Trefferzeilen blau markierst sollten auch nur 2 Zeilen in der
>> ErgebnisTabelle auftauchen.
> ich dachte, dass alle Treffer der Mappe in einer einzigen Tabelle
> aufgelistet würden.

Du denkst zu kompliziert! Ein Treffer ist der komplette String wenn er
in die Suchmaske paßt ("IW" am Anfang "??? ???" am Ende; nur! am Ende).
Wenn der String "IW Name1 /111 222" 4 Mal auftritt (der identische,
komplette String) kommt er nur einmal in die Ergebnistabelle, aber mit
der Summe aller 4 Zeiten dieser Strigs (mal der Mitarbeiterzahl).

Ein weiterer String lander im Suchmuster:
IW Name6 555 222
er wird nur einmal gefunden, landet in der Ergebnistabelle mit seiner
zugehörigen Zeit mal der Mitarbeiterzahl.
usw.

Ebenso mit allen anderen kompletten Strings. Du mußt nicht Teile
abweichender Strings dazunehmen. Daher fällt auch
"IW Name1 /111 222 Wa"
nicht ins Suchmuster!

> Im Moment ist es so, dass in beiden Tabellen
> zusammen 5 Treffer sind. Davon sind zwei identisch und werden somit
> addiert und du bekommst 4 Einträge.

IW abc 123 456
AW abc 123 457
ZW abc 123 458
IW abc 123 459 1
BW abc 123 460
IW abc 123 461 2
IW abc 123 462 99
IW zzz 123 463

Keiner der IW- Strings ist identisch!

IW abc 123 456
und
IW abc 123 456
wären das!
oder
AW cdd 444 888
AW cdd 444 888
aber die fallen aus dem Muster.

>> Wegen der Stringlänge werde ich einfach mal 50 Blatter mit je 10
>> Stringtabellen produzieren in der Testmappe. Dauert.

> Du musst auch nicht unbedingt den Ausgabebereich in einen String wandeln
> und dann im Instr überprüfen. Es gäbe auch die Möglichkeit mit der
> Find-Methode den Ausgabebereich zu durchsuchen. Bei Fund addieren der
> Werte, bei Fehlen unten anfügen.

Mal sehen. Ich hab die 50-Blatt- Mappe fertig, aber bei dem
Bereichsnamen ("Daten") hackt der Code erstmal. Der im Hauptblatt gilt
laut Namensmanager für die Mappe, der in den wegkopierten Blättern für
das einzelne Blatt.
Ich möchte das auch erstmal so lassen weil es später dem "Ernstfall"
entspricht und sehen ob ich was anderes als Fehler finden kann.

Ich will noch in den 50 Sheets (mit je 7 Tabellen) noch Strings abändern
um mehr Ergebnisse zu bekommen (sind ja jetzt alles Kopien von Nr.1).

Dann kann ich INSTR mit einem gigantischen String testen und bin schlauer.
Die FIND-Methode in diesem Fall ist auch eine gute Idee. Hatten wir das
nicht vor einigen Tagen schon so?

Hans

[Hans.Alborg]

Hi Ulrich,

Public Property Get Store() As Scripting.Dictionary

...
End Property

Sorry das mag mein altes VBA garnicht. Mein Excel sperrt die
Modulverarbeitung.

Ohne diesen Codebereich läuft VBA zumindest.

Hans
(behält Excel 2007 bis es wieder 3'er Lizenzen gibt!)

[Ulrich Möller]

Hallo Hans,

Am 22.01.2017 um 22:04 schrieb Hans.Alborg:
> Hi Ulrich,
>
> Public Property Get Store() As Scripting.Dictionary
> ...
> End Property
>
> Sorry das mag mein altes VBA garnicht. Mein Excel sperrt die
> Modulverarbeitung.
>

Das ist kein "altes" VBA und hat auch nichts speziell mit Excel 2007 zu
tun.

> Ohne diesen Codebereich läuft VBA zumindest.
>
> Hans
> (behält Excel 2007 bis es wieder 3'er Lizenzen gibt!)

Hatte ich vergessen zu erwähnen:
Das VBA Projekt benötigt natürlich einen Verweis auf die "Microsoft
Scripting Runtime", dann sollte es gehen.

Ulrich

[Ulrich Möller]

Am 22.01.2017 um 22:04 schrieb Hans.Alborg:

Hier der Link für das Beispiel:
https://1drv.ms/x/s!Ank2PUnOf8USghRwzWBGifk2h0mr
<https://1drv.ms/x/s%21Ank2PUnOf8USghQidmIaikYsdZmw>

Ulrich

[Hans.Alborg]

Hans.Alborg schrieb:

> Dann kann ich INSTR mit einem gigantischen String testen und bin schlauer.
> Die FIND-Methode in diesem Fall ist auch eine gute Idee. Hatten wir das
> nicht vor einigen Tagen schon so?

So. Läuft durch und der Prüfstring ist 275 Zeichen lang. Meine Annahme
lag bei max 255 Zeichen.
Das addieren der Zeiten (Spalte 3) ist schon sichtbar...

Morgen werd ich mal gucken wie ich die Anzahl Treffer in das Ergebnis
(2.Spalte) bekomme.

Daslöschen der Ergebnistabelle vor dem Start des Codes ist unbedingt nötig.

Gute Nacht!
Hans

[Ulrich Möller]

Sorry, da hat etwa mit der Freigabe nicht geklappt:


Hier der korrigierte Link:
https://1drv.ms/f/s!Ank2PUnOf8USghMMreQ68tGcNamz
<https://1drv.ms/f/s%21Ank2PUnOf8USghMMreQ68tGcNamz>

Ulrich

[Hans.Alborg]

Ulrich Möller:

> Hier der Link für das Beispiel:
> https://1drv.ms/x/s!Ank2PUnOf8USghRwzWBGifk2h0mr
> <https://1drv.ms/x/s%21Ank2PUnOf8USghQidmIaikYsdZmw>

Kommt ein Anmeldefenster. Zum lesen? Hab mein MS-Konto lange nicht
genutzt...morgen...gähn...

"Microsoft Scripting Runtime" hab ich schon mal Haken gesetzt.

Gute Nacht,

Hans

[Claus Busch]

Hallo Hans,

Am Sun, 22 Jan 2017 21:57:40 +0100 schrieb Hans.Alborg:

> Du denkst zu kompliziert! Ein Treffer ist der komplette String wenn er
> in die Suchmaske paßt ("IW" am Anfang "??? ???" am Ende; nur! am Ende).
> Wenn der String "IW Name1 /111 222" 4 Mal auftritt (der identische,
> komplette String) kommt er nur einmal in die Ergebnistabelle, aber mit
> der Summe aller 4 Zeiten dieser Strigs (mal der Mitarbeiterzahl).

das war mir vollkommen klar. Aber ich dachte, dass alle Daten auf Blatt1
kommen und da in Blatt1 und Blatt2 ein String identisch waren, wurden
die addiert.
So wie du jetzt beschreibst, scheinst du für jedes Blatt ein gesonderte
Auswertung zu machen.

> Mal sehen. Ich hab die 50-Blatt- Mappe fertig, aber bei dem
> Bereichsnamen ("Daten") hackt der Code erstmal. Der im Hauptblatt gilt
> laut Namensmanager für die Mappe, der in den wegkopierten Blättern für
> das einzelne Blatt.

Wenn du für jedes Blatt eine extra Auswertung machst, kannst du für
jedes Blatt den gleichen Namen verwenden. Du musst ihn dann nur auf das
Blatt beziehen statt auf die Mappe.
Erstelle deine Namen so:

Sub NamenErstellen()
Dim i As Long

For i = 1 To Sheets.Count
With Sheets(i)
.Names.Add Name:="Daten", RefersTo:= _
"=OFFSET(" & .Name & "!$CI$50,,,COUNTA(" _
& .Name & "!$CI$50:$CI$1000))"
.Names.Add Name:="Zeiten", RefersTo:= _
"=Offset(" & .Name & "!Daten,,1)"
End With
Next
End Sub

Und dann ändere den Code für die Auswertung, damit die Daten auf jedes
Blatt kommen und dass vorher die Bereiche gelöscht werden:

Sub Test()
Dim myRng As Range, c As Range, dest As Range
Dim i As Long, n As Long
Dim FirstAddress As String, myStr As String
Dim varTmp() As Variant, varData As Variant

'Hier werden die Bereiche gelöscht
For i = 1 To Sheets.Count
With Sheets(i)
If Len(.Range("CJ50")) > 0 Then .Range("Zeiten").ClearContents
If Len(.Range("CI50")) > 0 Then .Range("Daten").ClearContents
End With
Next

For i = Sheets.Count To 1 Step -1

n = 0

With Sheets(i)
Set myRng = .Range("A11:Z50")
Set c = myRng.Find("IW*??? ???", LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
FirstAddress = c.Address
Do

n = n + 1
ReDim Preserve varTmp(1 To 2, 1 To n)
varTmp(1, n) = c
varTmp(2, n) = c.Offset(, 1) * c.Offset(, 2)
Set c = myRng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

varTmp = Application.Transpose(varTmp)

For n = LBound(varTmp) To UBound(varTmp)
If Len(.Range("CI50")) = 0 Then
.Range("CI50") = varTmp(n, 1)
.Range("CJ50") = varTmp(n, 2)

Else
varData = .Range("Daten")
If IsArray(varData) Then
myStr = Join(Application.Index(Application.Transpose(varData), 1, 0), ",")

Else
myStr = varData

If InStr(myStr, varTmp(n, 1)) Then
Set c = .Range("Daten").Find(varTmp(n, 1))
c.Offset(, 1) = c.Offset(, 1) + varTmp(n, 2)
Else
Set dest = .Cells(.Rows.Count, 87).End(xlUp)(2)
dest = varTmp(n, 1)
dest.Offset(, 1) = varTmp(n, 2)
End If
End If
End If
Next
.Range("Zeiten").NumberFormat = "[h]:mm"
End With

Next
End Sub

Oder schau nochmal in OneDrive vorbei.

[Claus Busch]

Hallo Hans,

> Oder schau nochmal in OneDrive vorbei.

der Link hat sich geändert:
https://1drv.ms/x/s!AqMiGBK2qniTgYgsoh5theJRDQRi0g

[Hans.Alborg]

Hallo Ulrich,

Ulrich Möller schrieb:

> Hier der korrigierte Link:
> https://1drv.ms/f/s!Ank2PUnOf8USghMMreQ68tGcNamz
> <https://1drv.ms/f/s%21Ank2PUnOf8USghMMreQ68tGcNamz>

Danke, hat geklappt. Ich habs mir runtergeladen und sehe es mir morgen
genauer an.

Meine -langsame- Lösung (mit der ich aber meine Ideen am besten
entwickeln kann) und Eure Vorschläge werden in meiner "echten" Mappe in
je einem Modul verwirklicht sobald ich sie in der Testmappe zum Laufen
bekomme. Sie werden dann so angepaßt daß sie denselben Job machen.
Es wird also für jeden einen Button geben der dann dasselbe bewirkt.

Am Jahresende werde ich dann wohl die Performance schätzen können...

Na, Claus' Code läuft seit heute "beinahe" schon damit.

Hans

[Hans.Alborg]

Hi Claus,

Claus Busch schrieb:

>> Oder schau nochmal in OneDrive vorbei.
>
> der Link hat sich geändert:
> https://1drv.ms/x/s!AqMiGBK2qniTgYgsoh5theJRDQRi0g

> Mit freundlichen Grüßen
> Claus

Wuhu! Mach Dir nicht soviel Arbeit, Dein Code läuft bei mir ja beinahe!

Da er in der 50-Blatt-Testmappe gut lief habe ich ihn heute in die
richtige Mappe transplantiert.

Leider eine kleine Abstoßreaktion:

ich gebe mal was vom unteren Codeteil wieder:
' -------------------------------------------------
.Cells(44 + n, 85).Value = varTmp(n, 1)
If Len(.Range("CJ46")) = 0 Then
.Range("CJ46") = varTmp(n, 1)
.Range("CL46") = varTmp(n, 2)

Else
varData = .Range("Daten")
If IsArray(varData) Then
myStr = ""

myStr = Join(Application.Index(Application. _

Transpose(varData), 1, 0), ",")
Else

' ------------------------------------------------
die erste Zeile schreibt mir die Strings varTmp(n, 1) in Spalte 84, wo
ich sie gut sehen kann.
Sicherheitshalber hab ich mystr gelöscht ehe es neu gebildet wird.
Und da kommt der Fehler: es wird ein String
"IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,," erzeugt (Zahlen im String und
Kommazahl hier willkürlich).
Und ein String kommt auch nur als Ergebnis (Zeile 46).

Also: die Strings (20 Stck.) stehen in Spalte 84.
Was ist da los?
In der 50-Blatt-Testmappe lief das.

Hans
PS: Mit "Data" und "Zeiten" gibt's keine Probleme mehr!

[Hans.Alborg]

Hans.Alborg:

> Leider eine kleine Abstoßreaktion:

Oh, das gibt Mißverständnisse:

> .Cells(44 + n, 85).Value = varTmp(n, 1)

> die erste Zeile schreibt mir die Strings varTmp(n, 1) in Spalte 84, wo
> ich sie gut sehen kann.

Das ist nur für Testzwecke!

> Sicherheitshalber hab ich mystr gelöscht ehe es neu gebildet wird.

Das auch...

> Und da kommt der Fehler: es wird ein String

> "IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,," erzeugt...

> Und ein String kommt auch nur als Ergebnis (Zeile 46).

Natürlich "IW xxx /123 456" ohne Kommas, und die Zeit auch.

Hans

[Claus Busch]

Hallo Hans,

Am Mon, 23 Jan 2017 21:36:49 +0100 schrieb Hans.Alborg:

>> Sicherheitshalber hab ich mystr gelöscht ehe es neu gebildet wird.
> Das auch...
>
>> Und da kommt der Fehler: es wird ein String
>> "IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,," erzeugt...
>
>> Und ein String kommt auch nur als Ergebnis (Zeile 46).
> Natürlich "IW xxx /123 456" ohne Kommas, und die Zeit auch.

schau nochmal in OneDrive rein. In der neuen Version wird der String
nicht benötigt.

[Claus Busch]

Hallo Hans,

Am Mon, 23 Jan 2017 21:27:15 +0100 schrieb Hans.Alborg:

> ich gebe mal was vom unteren Codeteil wieder:
> ' -------------------------------------------------
> .Cells(44 + n, 85).Value = varTmp(n, 1)
> If Len(.Range("CJ46")) = 0 Then
> .Range("CJ46") = varTmp(n, 1)
> .Range("CL46") = varTmp(n, 2)
> Else
> varData = .Range("Daten")
> If IsArray(varData) Then
> myStr = ""
> myStr = Join(Application.Index(Application. _
> Transpose(varData), 1, 0), ",")
> Else
> ' ------------------------------------------------
> die erste Zeile schreibt mir die Strings varTmp(n, 1) in Spalte 84, wo
> ich sie gut sehen kann.

dann musst du aber auch den benannten Bereich "Daten" in Spalte 84
erstellen.

> Sicherheitshalber hab ich mystr gelöscht ehe es neu gebildet wird.
> Und da kommt der Fehler: es wird ein String
> "IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,," erzeugt (Zahlen im String und
> Kommazahl hier willkürlich).

Dann stimmt etwas mit der Formel für den dynamischen Bereich. Wenn der
Bereich korekt ist, umfasst er nur die wirklichen Einträge.
Schau in OneDrive in die neue Version. Die benötigt diesen String nicht
mehr.

[Hans.Alborg]

Hallo Claus,

Claus Busch schrieb:
> Hans.Alborg schrieb:
>

>> "IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,," erzeugt (Zahlen im String und

> Dann stimmt etwas mit der Formel für den dynamischen Bereich. Wenn der

> Bereich korekt ist, umfasst er nur die wirklichen Einträge.

Ich hab das auch überprüft aber vielleicht was übersehen.

Aber: den String in die Tabelle schreiben lassen.
Gesamt sieht er so aus:

"IW xxx /123 456,,,,,,,,,,,,,,,,,,,,,,,, _
,,,,,,,,,W xxx /222 456IW xxx /333 456IW xxx /123 456 usw."

also ein String, dann alle (?) Kommas und dann brav die anderen Strings
direkt hintereinander.
(der Umbruch ist hier wegen dem Reader von mir gemacht).

Wieso das so ist hab ich nicht rausbekommen, aber ich konnte die Kommas
weglassen und dann war alles ok, INSTR sind die Kommas egal.

> Schau in OneDrive in die neue Version. Die benötigt diesen String nicht
> mehr.

Ich hab gestern ja schon gesehen daß Du FIND verwendest. Ich war halt
neugierig was da los war.

Ich lad mir Deine neue Onedrive- Version runter und sehe sie mir morgen
an wenn ich hoffentlich ein bisserl zur Ruhe komme.

Hans

[Hans.Alborg]

Hans.Alborg schrieb:

> Danke, hat geklappt. Ich habs mir runtergeladen und sehe es mir morgen
> genauer an.

Auf jeden Fall läuft Dein Beispiel auf meinen Rechnern auch. Das
Anpassen an meine Vorgaben wird nicht so fix gehen, da muß wenigstens
ein Wochenende kommen wo ich in Ruhe fummeln kann. Freu mich drauf!

Hans

[Ulrich Möller]

Hallo Michael,

Am 19.01.2017 um 02:44 schrieb Michael Schwimmer:
> Sorry,
> ich habe im vorherigen Posting meinen alter ego benutzt, ist in manchen NGs
> hilfreich, wenn man Meinungen vertritt, die nicht unbedingt dem Mainstream
> entsprechen und man nicht unter Generalverdacht gestellt werden möchte, von
> irgendwelchen Lobbygruppierungen gekauft zu sein.
>
> Michael
kein Problem. Ideen, Anregungen, Einwände oder Hinweise immer
willkommen. Deshalb wird man nicht unter "Generalverdacht" gestellt.
Auch wenn man einer Lobbygruppe angehören sollte, ist das zunächst ja
nichts schlimmes, solange man einen sinnvollen Beitrag leistet und nicht
immer Standardantworten, wie z.B. man solle auf einen neue Version gehen
oder die Version sei nicht mehr supportet, postet. Das ist sinnlos (im
wahrsten des Wortes) für denjenigen, der ein Problem hat und nicht
gerade sehr hilfreich.

Grüße
Ulrich