Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1104to1108
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

Noch einmal offen (Tino) Array Variable Splitten)

Noch einmal offen (Tino) Array Variable Splitten)
chris
Hallo VBA Profis,
ich wollte eigentlich warten aber ich brauche schnell eine Lösung sonst kann ich´mit meinem Tool nicht weiter machen :(
Ich hoffe Ihr könnt mir helfen.
gestern habe ich eine Super Lösung für mein Problem von Tino bekommen.
Aber leider kann ich es nicht umbauen wie ich es brauche:(
Weil Tino den Bereich auf einem zellbereich nimmt zum Beispiel A1 bis A33
Aber ich die Kürzel und Namen schon in einem String habe.
bekomme es leider nicht alleine hin und würde mich sehr über Hilfe freuen.
Unten mit dem Link sieht mann meine letzte frage dazu.
Würde mich noch einmal sehr freuen wenn sich jemand die zeit für mich nimmt.
Vielen dank dafür im voraus!
gruß Chris
https://www.herber.de/forum/messages/1107725.html

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW:Zusatz
07.10.2009 08:43:33
chris
Noch einwas habe ich vergessen.
In tinos Exceldatei stehen die namen so:
"Christian" "Nachname" "AKürzel"
"Michael" "Nachname" "FKürzel"
aber in meinem Array(String) stehen die Namen einfach nebeneinander ohne die " "
Also etwa so:
"Christian Nachname AKürzel Michael Nachname FKürzel"
Zwischen den einzelnen Namen und kürzel steht ein chr(10) etwa so:
"Christian Nachname AKürzel chr(10) Michael Nachname FKürzel"
Vielen dank noch einmal !
String-Spezialsortierung
07.10.2009 09:37:22
Erich
Hi Chris,
kannst du das hier verwenden?

Sub SortiereString2()
Dim Bereich As Range
Dim meAr, tempAr(), TextAr
Dim A As Long, AA As Long
Dim arrW, strQ As String
'                                   hier wird Beispiel-String strQ erstellt
Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp))
arrW = Application.Transpose(Bereich.Value2)
strQ = Join(arrW, Chr(10))
'                                   ab hier wird strQ umsortiert
meAr = Split(strQ, Chr(10))
ReDim tempAr(0 To UBound(meAr), 1 To 1)
For A = LBound(meAr) To UBound(meAr)
If InStr(meAr(A), " ") > 0 Then
TextAr = Split(meAr(A), " ")
For AA = LBound(TextAr) To UBound(TextAr)
If AA + 1 > UBound(tempAr, 2) Then _
ReDim Preserve tempAr(0 To UBound(tempAr), 1 To AA + 1)
tempAr(A, AA + 1) = TextAr(AA)
Next AA
End If
Next A
prcQuickSort LBound(tempAr), UBound(tempAr), 3, True, tempAr
For A = 0 To UBound(tempAr)
meAr(A) = Empty
For AA = 1 To UBound(tempAr, 2)
meAr(A) = meAr(A) & tempAr(A, AA) & " "
Next AA
If Right$(meAr(A), 1) = " " Then meAr(A) = Left$(meAr(A), Len(meAr(A)) - 1)
Next A
strQ = Join(meAr, Chr(10))          ' strQ ist sortiert
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: String-Spezialsortierung
07.10.2009 10:18:45
chris
Hallo Erich,
ich Glaube nicht.
Weil du ja auch den String aus meheren zellen ausliest.
Aber ich habe in ja schon durch eine Schleife in einen String eingelesen.
und das nicht aus einem bereich A1 bis z.b A10 sondern aus meheren zellen die nicht nebeneinander stehen.
Dann habe ich den String den ich splitten möchte und dann sortieren.
Verstehst du mich ? Wenn nein vielleicht wird es im alten beitrag klarer.
Aber ansonsten passt es vielen Dank wenn du mir noch dabei helfen könntest wäre klasse!
gruß Chris
AW: String-Spezialsortierung
07.10.2009 11:31:00
Erich
Hi Chris,
doch, ich habe dich wohl richtig verstanden.
Wo der String herkommt, spielt doch keine Rolle.
In meinem Beispiel habe ich ihn (mit den 3 Codezeilen nach den Deklarationen) aus Daten einer Tabelle erzeugt.
Diese 3 Zeilen lässt du einfach weg. strQ wird bei dir anders belegt - wie genau, weiß ich ja nicht.
Dafür hatte ich auch die beiden Kommentare in den Code geschrieben.
Wenn du damit nicht klar kommst, solltest du besser deinen Code zeigen, damit wir den Sort einpassen können.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: String-Spezialsortierung
07.10.2009 14:34:58
chris
Hallo Erich,
danke noch mal für dein beispiel.
ich habe es jetzt einmal versucht zu erklären was ich leider ohne Hilfe nicht hin bekomme:(
Ich habe in deinen Code eingefügt wie du ´Die strq erstellst mit der das sortieren klappt.
Und wie ich die Strq erstelle mit der dasnicht klappt.
Könntest du mir sagen wie ich das umbauen muss das es auch mit meine Strq klappt ?
Wäre echt super Erich.
Danke
Option Explicit
Sub SortiereString2()
Dim Bereich As Range
Dim meAr, tempAr(), TextAr
Dim A As Long, AA As Long
Dim arrW, strQ As String
' hier wird deine Beispiel-String strQ erstellt  --- mit der es klappt das ganze sortieren
Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp))
arrW = Application.Transpose(Bereich.Value2)
strQ = Join(arrW, Chr(10))
'hier wird meine strq erstellt  --- hier wird meine strq erstellt mit der das Leider nicht  _
klappt (
For xx = 23 To 33
If MyWorkbook_test_User.Worksheets("daten_").Cells(ZeileDb, xx)  "" Then
strQ = strQ & Chr(10) & MyWorkbook_test_User.Worksheets("daten_").Cells(Zeile_Db, _
xx)
Else
End If
Next
'                                   ab hier wird strQ umsortiert
meAr = Split(strQ, Chr(10))
ReDim tempAr(0 To UBound(meAr), 1 To 1)
For A = LBound(meAr) To UBound(meAr)
If InStr(meAr(A), " ") > 0 Then
TextAr = Split(meAr(A), " ")
For AA = LBound(TextAr) To UBound(TextAr)
If AA + 1 > UBound(tempAr, 2) Then _
ReDim Preserve tempAr(0 To UBound(tempAr), 1 To AA + 1)
tempAr(A, AA + 1) = TextAr(AA)
Next AA
End If
Next A
prcQuickSort LBound(tempAr), UBound(tempAr), 3, True, tempAr
For A = 0 To UBound(tempAr)
meAr(A) = Empty
For AA = 1 To UBound(tempAr, 2)
meAr(A) = meAr(A) & tempAr(A, AA) & " "
Next AA
If Right$(meAr(A), 1) = " " Then meAr(A) = Left$(meAr(A), Len(meAr(A)) - 1)
Next A
strQ = Join(meAr, Chr(10))          ' strQ ist sortiert
Cells(1, 5) = strQ
End Sub

Anzeige
AW: String-Spezialsortierung
07.10.2009 16:07:42
Erich
Hi Chris,
ein klein wenig hab ich dein Einlesen noch umgestrickt, dann klappt es mit den Testdaten,
die in der Mappe stehen.

Sub SortiereString2()
Dim meAr, tempAr(), TextAr
Dim A As Long, AA As Long
Dim arrW, strQ As String
Dim ZeileDb As Long, xx As Long
'  hier wird meine strq erstellt --- mit der das Leider DOCH klappt
ZeileDb = 11
'With MyWorkbook_test_User.Worksheets("daten_")
With ThisWorkbook.Worksheets(1)                 ' für Test: Daten in dieser Mappe
For xx = 23 To 33
If .Cells(ZeileDb, xx)  "" Then
If strQ  "" Then strQ = strQ & Chr(10)
strQ = strQ & .Cells(ZeileDb, xx)
End If
Next
End With
'                                   ab hier wird strQ umsortiert
meAr = Split(strQ, Chr(10))
ReDim tempAr(0 To UBound(meAr), 1 To 1)
For A = LBound(meAr) To UBound(meAr)
If InStr(meAr(A), " ") > 0 Then
TextAr = Split(meAr(A), " ")
For AA = LBound(TextAr) To UBound(TextAr)
If AA + 1 > UBound(tempAr, 2) Then _
ReDim Preserve tempAr(0 To UBound(tempAr), 1 To AA + 1)
tempAr(A, AA + 1) = TextAr(AA)
Next AA
End If
Next A
prcQuickSort LBound(tempAr), UBound(tempAr), 3, True, tempAr
For A = 0 To UBound(tempAr)
meAr(A) = Empty
For AA = 1 To UBound(tempAr, 2)
meAr(A) = meAr(A) & tempAr(A, AA) & " "
Next AA
If Right$(meAr(A), 1) = " " Then meAr(A) = Left$(meAr(A), Len(meAr(A)) - 1)
Next A
strQ = Join(meAr, Chr(10))          ' strQ ist sortiert
Cells(1, 5) = strQ                  ' Ausgabe
End Sub
Ob es dann auch in deiner Mappe funzt, hängt auch von den dortigen Daten ab.
Probier mal: https://www.herber.de/bbs/user/64930.xls
Kleine Tücken: ZeileDb hieß mal so, mal Zeile_Db. MyWorkbook_test_User ist unbekannt.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: String-Spezialsortierung
08.10.2009 07:16:28
chris
weiß gar nicht was ich sagen soll.genau so wollte ich es !!
Vielen Vielen Dank an Dich Erich !
Nach mehrern Ansätzen genau richtig !
Auch An Tino herzlichen danke !!!!!!!! Auch dein Code klappt perfekt !!
Danke an euch !
AW: AW:Zusatz
07.10.2009 09:43:48
Martin
Hallo,
wie ist der Zeilenumbruch in Deinem String definiert? - Durch ein Chr(13)? - Oder sind alle Zeilen ohne Trennungszeichen in Deinen String eingelesen? Also so:
"Christian" "Nachname" "AKürzel" "Michael" "Nachname" "FKürzel" "Thomas.....
Viele Grüße
Martin
AW: AW:Zusatz
07.10.2009 10:11:37
chris
durch chr(10) ist der zeilenumbruch definiert.
danke erst einmal.
vielleicht so...
07.10.2009 15:32:05
Tino
Hallo,
hier die Lösung, habe ich auch in den anderen Beitrag geschrieben, nur den Code in Modul2 ersetzen.
Sub SortiereString()
Dim Bereich As Range
Dim meAr, tempAr(), TextAr
Dim A As Long, AA As Long
Dim strMeinText As String

strMeinText = "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Christian Nachname AKürzel" & Chr(10) & _
              "Michael Nachname FKürzel" & Chr(10) & _
              "Thomas Nachname BKürzel"

meAr = Split(strMeinText, Chr(10))

Redim Preserve tempAr(Ubound(meAr), 0)

For A = 0 To Ubound(meAr)
    If InStr(meAr(A), " ") > 0 Then
        TextAr = Split(meAr(A), " ")
        For AA = Lbound(TextAr) To Ubound(TextAr)
            If AA > Ubound(tempAr, 2) Then Redim Preserve tempAr(Ubound(tempAr), AA)
            tempAr(A, AA) = TextAr(AA)
        Next AA
    End If
Next A

prcQuickSort Lbound(tempAr), Ubound(tempAr), 2, True, tempAr

strMeinText = ""

For A = 0 To Ubound(tempAr)
   
    For AA = 0 To Ubound(tempAr, 2)
     strMeinText = strMeinText & tempAr(A, AA)
     If AA < Ubound(tempAr, 2) Then strMeinText = strMeinText & " "
    Next AA
    If A < Ubound(tempAr) Then strMeinText = strMeinText & Chr(13)
Next A

 MsgBox strMeinText
End Sub
Gruß Tino
Anzeige
mach aus *.gif noch *.jpg im Code oT.
07.10.2009 21:27:21
Tino
Kommentar war hier falsch. sorry oT.
08.10.2009 14:47:24
Tino

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige