Anzeige
Archiv - Navigation
1688to1692
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Aus Mehrfach vork. Werten diese auf 1x Vork. reduz

Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 19:52:07
Siegfried
Hallo alle Wissenden,
suche nach einer schnelleren Lösung als die momentan von mir verwendete
Columns(Ranch_Bereich).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Warum, es gibt 20 verschiedene Kriterien und 35 Unterschiedliche Länder.
Nicht in jedem Land treffen alle 20 Kriterien zu sondern nur 1, 3, 5 oder 15 usw. um die zutreffenden Kriterien herauszufiltern setze ich einen Filter auf das LAND, dann kopiere ich mir die alle hier nun zutreffen Kriterien aus einer Spalte in einen Hilfsbereich.
In diesem wende ich nun oben angeführte Funktion „).AdvancedFilter Action:=“ an um von jedem Kriterium nur mehr einen Eintrag zu haben.
Diese werden dann mit „Application.CutCopyMode = False“ und „Selection.Copy“ in eine weitere Hilfsspalte und von dieser in ein Array kopiert.
Aus diesem erfolgt dann im gleichen LAND die Setzung eines zweiten Filters auf die Werte aus dem Array und somit der Export sortiert nach Land und Kriterium in einen File.
Da also die Anzahl der Datensätze in den einzelnen Ländern sehr unterschiedlich sind, z.B. DEU mit 3.800, FRA od. ITA mit an die 1.000 braucht halt diese Funktion „Application.CutCopyMode = False“ daann etwas sehr lange.
Hätte nun versucht den Ranch_Bereich nur auf den zutreffenden Bereich in der Spalte „BM“ als Ranch_Bereich einzuschränken dies mag aber die „Application.CutCopyMode = False“ wiederum nicht. Da ich zu wenige VBA-Kenntnisse habe meine Frage gibt es dafür eine andere Lösung?
Mit einem DANKE schon im Vorhinein für jeden möglichen LÖSUNGSVORSCHLAG.
Gruß Siegfried
                               Application.CutCopyMode = False
Selection.Copy
Sheets("GrundDaten").Select
Sheets("GrundDaten").Range("BN1").Value = LandMap
Sheets("GrundDaten").Range("BM2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
SkipBlanks _
:=False, Transpose:=False  ' einfügen aller zutreffenden Art des  _
Landes
Rem                               Ranch_Bereich = "BM2:BM" & Trim(Val(Sheets(SelectName).Cells( _
1, 1))) + 1
Rem                               Worksheets("GrundDaten").Range(Ranch_Bereich).Select
Ranch_Bereich = "BM:BM"
Columns(Ranch_Bereich).Select
Columns(Ranch_Bereich).AdvancedFilter Action:=xlFilterInPlace,  _
Unique:=True
Call Start_End_Row(StartRow, EndRow, 65, "2C. App_RUNG2_F5") '  _
65 = GrundDaten Spalte BM
Ranch_Bereich = "BM" & Trim(StartRow) & ":BM" & Trim(EndRow) ' '  _
Spalte wählen und Filtern
Worksheets("Grunddaten").Range(Ranch_Bereich).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("GrundDaten").Range("BN2").Select   ' die einzeln  _
zutreffendn Art einfügen
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
SkipBlanks _
:=False, Transpose:=False
Call prcAutofilter(ActiveSheet.Name, "2D. App_RUNG2_F5")
Call Start_End_Row(StartRow, EndRow, 66, "2E. App_RUNG2_F5")  '  _
In GrundDaten Ergebnis CP_Art in Spalte BN
If StartRow = EndRow Then  '  zutreffenden Art-Bereich auswählen  _
und Array erstellen
Ranch_Bereich = "BN2:BN" & Trim(EndRow) + 1
Worksheets("Grunddaten").Select
AR = Range(Ranch_Bereich) ' aus GrundDaten die einzeln  _
zutreffende Art einfügen
Else
Ranch_Bereich = "BN2:BN" + Trim(EndRow)
Worksheets("Grunddaten").Select
AR = Range(Ranch_Bereich)   ' aus GrundDaten die einzeln  _
zutreffende Art einfügen
End If
Rem =*=*=*=*=*=*
SuchArt = AR  'Array in einen neuen Namen kopieren
L_SuchArt = UBound(SuchArt)  ' Länge ds Array auslesen

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 19:58:38
Hajo_Zi
naches es ohne VBA
Unterschiedliche Einträge in Spalte
http://www.excelformeln.de/formeln.html?welcher=194

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 20:55:52
Daniel
HI
so ganz verstehe ich noch nicht, was du tun willst.
Application.CutCopyMode = False macht nichts anderes, als den Excelzwischenspeicher leeren, eine Funktion, die man nicht wirklich braucht, sonden ggf lediglich die Rückfrage unterdrückt "es befinden sich noch größerer Datenmengen im Speicher)
der Spezialfilter ist bei größeren Datenmengen nicht besonders schnell
wenn du eine Liste ohne Duplikate brauchst, kopiere zuerst die ganze Liste und wende dann
Daten - Datentools - Duplikate Entfernen an.
Gruß Daniel
Anzeige
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 23:05:59
Siegfried
Hi Daniel,
also wenn du mir nun vielleicht noch verraten würdest wo ich
„Daten - Datentools - Duplikate Entfernen“ finde bzw. wie würde/müsste da die Formel aussehe?
Auch der Hinweis bzw. Musterdatei von „Hajo_Zi“ ist ja gut gemeint hätte dies bereits versucht, nur beim rein kopieren der Formel, dann natürlich auf meine Spaltenbezeichnung abgeändert versteht er nicht die Klammern {}, brachte mir also auch kein positives Ergebnis!
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 23:16:34
Siegfried
So hier eine Muster, ist nur das „GrundDaten“-Blatt aber in Spalte BM:BM stehen z.B. die Werte aus AUT welche auf je nur ein einmaliges Vorkommen abgeändert werden sollten!
https://www.herber.de/bbs/user/129274.zip
Anzeige
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 23:16:35
Siegfried
So hier eine Muster, ist nur das „GrundDaten“-Blatt aber in Spalte BM:BM stehen z.B. die Werte aus AUT welche auf je nur ein einmaliges Vorkommen abgeändert werden sollten!
https://www.herber.de/bbs/user/129274.zip
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
19.04.2019 23:16:36
Siegfried
So hier eine Muster, ist nur das „GrundDaten“-Blatt aber in Spalte BM:BM stehen z.B. die Werte aus AUT welche auf je nur ein einmaliges Vorkommen abgeändert werden sollten!
https://www.herber.de/bbs/user/129274.zip
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
20.04.2019 09:36:44
Werner
Hall Siegfried,
so:
Worksheets("GrundDaten").Columns(65).RemoveDuplicates Columns:=1, Header:=xlNo
Gruß Werner
Anzeige
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
20.04.2019 13:57:39
Siegfried
Hallo Werner,
DANKE für den Hinweis, damit erreiche ich nun mein gestecktes Ziel!
Gruß Siegfried
Gerne u. Danke für die Rückmeldung. o.w.T.
21.04.2019 13:26:31
Werner
AW: Gerne u. Danke für die Rückmeldung. o.w.T.
21.04.2019 20:00:04
Siegfried
Hallo Werner,
also meine sämtlichen Tests verliefen bis jetzt Super schnell im Vergleich zur vorher verwendeten Art.
Nur ein Problem habe ich noch wenn bei einem Land nur eine Art vorkommt.
Da muss ich jetzt mit dem Trick arbeiten den eigentlichen Bereich "BN2:BN2" dies mag das Array nicht auf "BN2:BN3" zu erweitern, dann liest er es als Array ein, nur das Array(2) ist eben leer.
Dies muss ich nun wieder an der Stelle wo es durchlaufen wird um im GesamtArray zu suchen an welcher Stelle der Suchbegriff liegt (dieser Wert wird benötigt) abfangen.
Wie müsste es lauten um nur aus einer Zeile,Spalte den Wert ins Array zu bekommen und dies eben dann nur eine Länge von 1 hat.
Hätte schon im WEB gesucht aber leider nichts für mich verständliches dazu gefunden!
Gruß Siegfried
Anzeige
AW: Gerne u. Danke für die Rückmeldung. o.w.T.
24.04.2019 23:00:49
Siegfried
Ja, ja so kann es einem auch gehen, da glaubt man es gibt Helferleins und dann rührt sich kein Schwanz?
OK wegen Ostern dachte ich alle sind irgendwo in Ferien und so unterwegs, darum keine Antwort.
Aber Heute auch noch nichts weder von Werner noch einem sonstigen Wissenden, schade, dachte dieses Problem mit Eurer Hilfe auch noch lösen zu können!
Gruß Siegfried
du hast sie ja wohl nicht mehr alle. o.w.T.
25.04.2019 10:40:53
Werner
AW: du hast sie ja wohl nicht mehr alle. o.w.T.
25.04.2019 18:55:25
Siegfried
Hallo Werner,
Entschuldige Bitte, wenn du dies in den falschen Hals bekommen hast.
Aber es ist manchmal wirklich so, entweder bekommt man massenhaft Rückmeldungen wo man als Unwissender nicht mehr weis wie man das alles umsetzen bzw. Anwenden soll oder man wird im Regen stehen gelassen.
Dabei glaube ich ist die Antwort für Wissende sicher ein Kinderspiel.
Gruß Siegfried
Anzeige
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
20.04.2019 14:05:05
Siegfried
Hallo Bernd P.
Kann deine Hilfeangebot leider nicht annehmen da mein Antivirenprogamm mit dieser Seite nicht einverstanden ist, siehe Bild
Userbild
AW: Aus Mehrfach vork. Werten diese auf 1x Vork. reduz
20.04.2019 16:02:03
Sulprobil
Hallo Siegfried,
Danke für den Hinweis. Ich verwende einen aktuellen Virenscanner für meine Website und meine Programme. Ich schaue mir das einmal in Ruhe an.
Das Programm Pstat:
Function Pstat(sFct As String, _
vCond() As Variant, _
ParamArray v() As Variant) As Variant
'Pstat performs sFct on last given column of v()
'for all combinations of the previous ones where corresponding
'elements of vCond are TRUE.
'Example:
'    A     B     C
' 1 Smith Adam   1
' 2 Myer Ben   3
' 3 Smith Ben    2
' 4 Smith Adam   7
' 5 Myer Ben   4
'Now select D1:F2 and array-enter
'=Pstat("sum", B1:B5="Ben", A1:A5,B1:B5,C1:C5) and you will get
'    D   E    F
' 1 Myer   Ben   7
' 2 Smith  Ben   2
'Reverse("moc.LiborPlus.www") V0.6 15-Oct-2009
Dim obj As Object
Dim vR As Variant
Dim i As Long, j As Long, k As Long
Dim lvdim As Long, lcdim As Long
Dim s As String, sC As String
Dim liscount As Long '1 if and only if we count
With Application.WorksheetFunction
sC = "|"
k = 0
v(0) = .Transpose(.Transpose(v(0)))
If LCase(sFct) = "count" Then liscount = 1
If UBound(v)  lvdim Then
Pstat = CVErr(xlErrRef)
Exit Function
End If
If lvdim > 100 Then lvdim = 100 'Let us start with small dim
On Error GoTo ErrHdl 'Please read
'http://www.sulprobil.com/Get_it_done/IT/Excel_Fun/Excel_VBA/Error_Trapping/error_trapping.html
ReDim vR(0 To UBound(v) + liscount, 1 To lvdim)
For j = 1 To UBound(v)
v(j) = .Transpose(.Transpose(v(j)))
If lcdim  UBound(v(j)) Then
Pstat = CVErr(xlErrRef)
Exit Function
End If
Next j
Set obj = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v(0))
If vCond(i, 1) Then
s = v(0)(i, 1)
For j = 1 To UBound(v) - 1 + liscount
s = s & sC & v(j)(i, 1)
Next j
If obj.Item(s) > 0 Then
Select Case LCase(sFct)
Case "cat", "concatenate"
vR(UBound(v), obj.Item(s)) = vR(UBound(v), _
obj.Item(s)) & "," & v(UBound(v))(i, 1)
Case "count"
vR(UBound(v) + 1, obj.Item(s)) = vR(UBound(v) + 1, _
obj.Item(s)) + 1
Case "max", "maximum"
If vR(UBound(v), obj.Item(s))  v(UBound(v))(i, 1) Then
vR(UBound(v), obj.Item(s)) = v(UBound(v))(i, 1)
End If
Case "sum"
vR(UBound(v), obj.Item(s)) = vR(UBound(v), _
obj.Item(s)) + v(UBound(v))(i, 1)
Case Else
Pstat = CVErr(xlErrRef)
End Select
Else
k = k + 1
obj.Item(s) = k
For j = 0 To UBound(v)
vR(j, k) = v(j)(i, 1)
Next j
If liscount = 1 Then vR(UBound(v) + 1, k) = 1
End If
End If
Next i
'Reduce result array to used area
If k > 0 Then ReDim Preserve vR(0 To UBound(v) + liscount, 1 To k)
Pstat = .Transpose(vR)
Set obj = Nothing
End With
Exit Function
ErrHdl:
If Err.Number = 9 Then
If i > lvdim Then
'Here we normally get if we breach Ubound(vR,2)
'So we need to increase last dimension
lvdim = 10 * lvdim
If lvdim > UBound(v(0)) Then lvdim = UBound(v(0))
ReDim Preserve vR(0 To UBound(v) + liscount, 1 To lvdim)
Err.Number = 0
Resume 'Back to statement which caused error
End If
End If
'Other error - terminate
On Error GoTo 0
Resume
End Function
Viele Grüße,
Bernd P
Anzeige
AW: Der aktuelle MS-Standard beanstandet nichts! orT
20.04.2019 21:11:16
Sulprobil
Danke, Luc.
Viele Grüße,
Bernd P

46 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige