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

Spaltenwerte in Array einlesen sofern diese ...

Forumthread: Spaltenwerte in Array einlesen sofern diese ...

Spaltenwerte in Array einlesen sofern diese ...
Peter
ein "," enthalten, sortieren doppelte löschen und einmalige Strings an neuem Ort ausgeben.
Guten Abend
Ich habe in einer Tabelle eine umfangreiche Auswertung (ca. 30'000 Zeilen), wobei in Spalte B in der Regel Name Vorname (abgetrennt durch ein Komma) steht. Die Namen kommen in der Regel mehrfach vor.
Ich habe verschiedentlich gelesen, dass mit Hilfe von Arrays sehr schnell Daten bearbeitet werden können. Deshalb möchte ich alle Werte der Spalte B in ein Array einlesen. Einzige Bedingung: Es dürfen nur Strings eingelesen werden, die ein , (Komma) enthalten.
Anschliessend sollten die Strings sortiert werden, die doppelten Strings eliminiert werden und dann die verbleibenden Strings an einer frei zu definierenden Stelle, z.B. in der Tabelle "Mitarbeiter" ab Zelle B2 ausgegeben werden.
Ist so was möglich (oder bloss Wunschdenken von mir)?
Danke für jede Hilfe.
Gruss, Peter
Beispieldatei: https://www.herber.de/bbs/user/64632.xls
Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
23.09.2009 21:00:39
Reinhard
Hallo Peter,
vielleicht so: 

Sub Kopier()
Dim Zei As Long, colC As New Collection, C As Long
On Error Resume Next
With Worksheets("Export1")
For Zei = 1 To .Cells(Rows.Count, 2).End(xlUp).Row
If InStr(.Cells(Zei, 2), ",") > 0 Then
colC.Add Item:=CStr(.Cells(Zei, 2)), key:=CStr(.Cells(Zei, 2))
End If
Next Zei
End With
With Worksheets("Mitarbeiter")
For Zei = 1 To colC.Count
.Cells(Zei + 1, 2) = colC(Zei)
Next Zei
.Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Sort _
Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

Gruß
Reinhard
Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
23.09.2009 21:13:11
ransi
HAllo Peter
Etwas anderer Ansatz:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Public Sub Sortierte_Unikate()
Dim objDic As Object
Dim vntIn As Variant
Dim L As Long
Dim Letzte As Long
Dim vntOut As Variant
With Tabelle1
    Letzte = .Range("B" & Rows.Count).End(xlUp).Row
    vntIn = .Range("B2:B" & Letzte).Value
End With
Set objDic = CreateObject("Scripting.Dictionary")
For L = LBound(vntIn) To UBound(vntIn)
    If InStr(1, vntIn(L, 1), ",") Then objDic(vntIn(L, 1)) = 0
Next
vntOut = objDic.keys
QuickSort vntOut
With Sheets("Mitarbeiter")
    .Range("B2").Resize(UBound(vntOut) + 1) = WorksheetFunction.Transpose(vntOut)
End With
Set objDic = Nothing
End Sub


Public Sub QuickSort(vSort As Variant, _
    Optional ByVal lngStart As Variant, _
    Optional ByVal lngEnd As Variant)
If IsMissing(lngStart) Then lngStart = LBound(vSort)
If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
Dim i As Long
Dim j As Long
Dim h As Variant
Dim x As Variant
i = lngStart: j = lngEnd
x = vSort((lngStart + lngEnd) / 2)
Do
While (vSort(i) < x): i = i + 1: Wend
While (vSort(j) > x): j = j - 1: Wend
    If (i <= j) Then
        h = vSort(i)
        vSort(i) = vSort(j)
        vSort(j) = h
        i = i + 1: j = j - 1
    End If
Loop Until (i > j)
If (lngStart < j) Then QuickSort vSort, lngStart, j
If (i < lngEnd) Then QuickSort vSort, i, lngEnd
End Sub


Schau zu dem Thema auch mal hier vorbei.
http://www.office-loesung.de/ftopic311971_0_0_asc.php
Da findest du noch einige Anregungen.
ransi
Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
24.09.2009 11:28:48
Peter
Hallo Ransi
Ich habe deinen Code nochmals durchgesehen und nachdem ich
With Tabelle1
durch
Sheets("Export1")
ersetzt habe, läuft der Code auch einwandfrei (die Exporttabelle ist die 2. im Workbook, daher läuft es - wie ich soeben herausgefunden habe - natürlich auch mit With Tabelel2).
Nochmals Dankeschön und Gruss, Peter
Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
23.09.2009 21:04:42
Josef
Hallo Peter,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Namen()
  Dim varNames As Variant, varResult() As Variant
  Dim lngLast As Long, lngIndex As Long, lngC As Long
  
  With Sheets("Export1")
    lngLast = .Cells(Rows.Count, 2).End(xlUp).Row
    varNames = UniqueList(.Range("B2:B" & CStr(lngLast)))
  End With
  
  For lngIndex = 0 To UBound(varNames)
    If InStr(1, varNames(lngIndex), ",") > 0 Then
      Redim Preserve varResult(lngC)
      varResult(lngC) = varNames(lngIndex)
      lngC = lngC + 1
    End If
  Next
  
  If lngC > 0 Then
    With Sheets("Mitarbeiter")
      .Range("B2:B" & CStr(lngC + 1)) = Application.Transpose(varResult)
    End With
  End If
  
End Sub


Function UniqueList(Matrix As Range, Optional Sorted As Boolean = True) As Variant
  Dim objDic As Object, rng As Range, varTmp() As Variant
  
  Set objDic = CreateObject("Scripting.Dictionary")
  
  For Each rng In Matrix
    If rng.Value <> "" Then objDic(rng.Value) = 0
  Next
  
  varTmp = objDic.keys
  
  If Sorted Then QuickSort varTmp
  
  UniqueList = varTmp
  
  Set objDic = Nothing
End Function

Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub

Gruß Sepp

Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
23.09.2009 21:08:52
Tino
Hallo,
kannst ja mal testen.
Sub Uebertragen()
Dim MeArray
Dim A As Long
Dim oDic As Object

With Sheets("Export1") 'Tabellennamen anpassen 
 MeArray = .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))
End With

Set oDic = CreateObject("Scripting.Dictionary")

For A = 1 To Ubound(MeArray)
 If InStr(MeArray(A, 1), ",") > 0 Then
  oDic(MeArray(A, 1)) = 0
 End If
Next A


With Sheets("Mitarbeiter")
 .Range("B2", .Cells(.Rows.Count, 2)).Value = ""
 .Range("B2").Resize(oDic.Count) = Application.Transpose(oDic.keys)
 .Range("B2", .Cells(.Rows.Count, 2)).Sort key1:=.Cells(2, 2), Order1:=xlAscending, Header:=xlNo
End With


End Sub
Gruß Tino
Anzeige
AW: Spaltenwerte in Array einlesen sofern diese ...
23.09.2009 21:55:44
Peter
Hallo zusammen
Es ist überwältigend, innert so kurzer Zeit 4 super funktionierende Lösungen erhalten zu haben. Vielen Dank!
Das hat mich auf die Idee gebracht, die den Zeitbedarf der einzelnen Varianten (genannt ist jeweils der Name des aufzurufenden Subs) zu ermitteln:
Bei rund 7000 Zeilen
Kopier - Millisekunden: 578
Namen - Millisekunden: 141
Uebertragen - Millisekunden: 31
Sortiere_Unikate - Millisekunden: 31
Bei meinem File mit rund 23100 Zeilen
Kopier - Millisekunden: 1219
Namen - Millisekunden: 328
Uebertragen - Millisekunden: 63
Bei Sortiere_Unikate erhielt ich ein Debug-Fehler, und zwar auf der Zeile
x = vSort((lngStart + lngEnd) / 2)
lngStart hat den Wert 0 und lngEnd den Wert -1
ergibt vSort = ausserhalb des gültigen Bereichs
da bin ich natürlich meilenweit davon entfernt, ausfindig zu machen, was wohl der Grund ist
Im Vergleich zu der Daten mit rund 7000 Zeilen sind im grösseren Datenbestand zwischendurch auch leere Zeilen enthalten. Könnte das der Grund sein?
Interessant ist auch, dass die Umlaute bei der Variante "Namen" die Umlaute anders sortiert werden (Reihenfolge a,e,ä; bei "Kopier" und Übertragen a,ä,e)
Nochmals vielen Dank und Gruss, Peter
Anzeige
;

Forumthreads zu verwandten Themen

Zahlen einer Tabelle in Userform einlesen
Josef

Guten Morgen!
Ich habe in einem Arbeitsblatt mehrere Tabellen.
In einer UserForm habe habe ich 460 TextBoxen, wobei die Zählung immer pro Reihe senkrecht erfolgt.
Spalte 1 = TextBox1-23, Spalte2 = TextBox24- TextBox46 usw.
Ich möchte nun z.B. die erste Tabelle in die Textboxen e...
20.08.2008 07:07:03
Thread-ID: 1003059
19 Beiträge
Daten in Spreadsheet einlesen
otto

Hi,
ich möchte Daten aus Tabelle in ein Spreadsheet einlesen, kommt aber "Objektdefinierter Fehler".
Was mach ich falsch ?
Dim zeiles As Integer, spalte As Integer, anzahl
zeile = 123
spalte = 1
For anzahl = 1 To 42
Spreadsheet1.Cells(zeiles, spalte) = Sheets("Liefer...
01.10.2008 11:05:50
Thread-ID: 1013552
2 Beiträge
Erweiterung eines Makros wg. Einlesen von Daten
Daten

Guten Morgen, kann man das Makro
Sub tt() Dim Zei As Long, Werte, W As Integer, Spa As Long For Zei = 30 To Range("A" & Rows.Count).End(xlUp).Row If InStr(Cells(Zei, 1), Chr(124)) > 0 Then Werte = Split(Cells(Zei, 1), Chr(124)) For W = LBound(Werte) To UBound(Werte) If Len(Werte(W)...
14.10.2008 08:20:04
Thread-ID: 1016214
9 Beiträge
Anzeige
Inhalt einer Webseite einlesen
Richard

Hallo,
ich hätt' da mal folgende Frage
Private Sub CommandButton1_Click() ThisWorkbook.FollowHyperlink "htt p://de.wikipedia.org/wiki/Hallo_Welt" End Sub
21.10.2008 11:22:37
Thread-ID: 1017906
5 Beiträge
Inhalte von Worddatei in Excel einlesen
Worddatei

Hallo,
gibt es eine Moglichkeit die Inhalte von mehreren Worddatei, die sich alle in einem Ordner befinden in Excel einfügen zu lassen.
Dabei soll auf jeder Tabelle der Excelmappe der Inhalt einer Worddatei erscheinen. auf der ersten Tabelle will ich später ein Inhaltsverzeichnis mit L...
26.10.2008 13:30:00
Thread-ID: 1019368
7 Beiträge
Kein Textvergleich nach Einlesen aus TXT
sunni

Hallo da draußen :-),
ich habe ein Problem, an dem ich mir echt die Zähne ausbeiße:
Ich habe (über VBA) aus einer TXT Daten in Excel eingelesen. Die Zahlen konnte ich "verwendbar" machen, indem ich diese mit 1 multipliziert habe. Aber der Text wird nicht als Text erkannt.
Hintergrun...
30.10.2008 14:29:00
Thread-ID: 1020611
4 Beiträge
VBA ExcelDateinamen und Arbeitsblattnamen einlesen
MarkusL

Hallo,
gibt es per VBA eine Möglichkeit alle Excel Dateien eines Verzeichnisses inkl. der jeweils enthaltenen Arbeitsblattnamen einzulesen (der Name der Exceldatei sollte ohne .xls ausgegeben werden), so dass nachfolgendes Ergebnis erzeugt wird:
Dateiname.......Arbeitsblattname
Date...
16.11.2008 15:07:00
Thread-ID: 1024906
5 Beiträge
Namen in Array einlesen und an Fkt. übergeben
adrian

Hi,
bin mir hierbei nicht ganz sicher ob das so klappt.
Möchte mit dier Funktion ("SearchOEM"), die ein Namen ("OEMName") zurückgibt, falls in einem Bereich ("ODMArea") ein Suchname ("ODMName") vorkommt.
Die Namen die diese Fkt. zurückgibt möchte ich in einem Array Speichern und an...
19.01.2009 13:06:00
Thread-ID: 1041390
4 Beiträge
Anzeige
Wert einer Zelle einlesen ?
Gerd

Halo!
Habe ein Problem bei dem ich nicht weiterkomme und bitte um Eure Hilfe.
Ich lese über VBA die letzte beschriebene bzw. erste freie Zeile in einer Tabelle aus in die ich dann schreibe. Ich hätte gerne daß VBA sich einen Wert, in dieser Zeile Spalte N merkt, ohne daß ich aber ein M...
03.02.2009 16:59:57
Thread-ID: 1046719
7 Beiträge
Inhalt einer ListBox in die ComboBox einlesen
Edie

Hallo Zusammen,
wie kann ich den Inhalt einer ListBox in die ComboBox einlesen?
Bei z. B. cboPfad.Value = lstGeneral.List(lstGeneral.ListIndex) wird nur ein
Wert eingelesen, nicht aber der ganze Inhalt der „lstGeneral“
Hat jemand einen Tipp oder Beispiel?
Vielen Dank im Vor...
11.02.2009 08:37:00
Thread-ID: 1049438
3 Beiträge
Bereichsnamen auslesen, in anderer Datei einlesen
Jörg

Hallo Forum,
ich lese meine vergebenen Bereichsnamen aus mit
Sub Namen_lesen_und_Bereich_angeben() For n = 1 To Names.Count Cells(n, 1) = Names(n).Name Cells(n, 2) = Names(n).Value Next n End Sub
Anschließend kopiere ich das Register in eine andere Datei und versuche dort die Be...
03.03.2009 15:46:37
Thread-ID: 1056016
6 Beiträge
Anzeige
Teil einer Formel in Zelle einlesen
Bernd

Hallo Freaks,
ich bastle nun schon geraume Zeit an einem Code, der mir in eine Zelle den Teil einer Formel (Kostenstellennamen) aus einer anderen Zelle schreibt.
Der nachstehene Code (von einem ausgeschiedenen Kollegen) ersetzt einen KST-Namen in einem Link mit einem neuen KST-Namen aus...
13.04.2009 12:55:24
Thread-ID: 1068432
6 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige