Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

array sortieren und doppelte löschen danach zurück

Betrifft: array sortieren und doppelte löschen danach zurück von: Hardy
Geschrieben am: 27.08.2004 18:32:49

Hallo alle zusammen.
Bitte nicht schlagen, habe schon div. Beiträge zu meinem Prob gefunden - allerdings habe ich wohl ein Brett vorm Kopf.

Ich lese div. Bezeichnungen in ein Array ein und möchte nun die doppelten löschen und die anderen in ein anderes Array schreiben. Mit den bislang gefunden Codes kam ich irgendiwe nicht zurecht.
Würde mich über einen Tipp mit sort-Funktionen oder so etwas freuen.
Auf "dumme" Beschimpfung mag ich gerne verzichten. Ich habe mir vorher schon Gedanken mit Schleifen und allem gemacht, komme aber momentan nicht auf eine Lösung.

Vielen Dank schon einmal im Voraus, Hardy

  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Ulf
Geschrieben am: 27.08.2004 18:36:17

"Ich lese div. Bezeichnungen in ein Array ein"

Woher werden die gelesen?

Ulf


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Hardy
Geschrieben am: 27.08.2004 19:17:31

Ich habe eine Tabelle in der ich Gerätespezifische Daten eingebe, z.B. Bezeichnung, Seriennummer u.ä..
Auf der eigentlichen Seite gebe ich nun die Seriennummer ein, nach der ich suchen will. Das Ergebnis lasse ich mir dann in einer Auflistung anzeigen. Nun kann es vorkommen, dass es identische Seriennummern gibt, aber bei verschiedenen Geräten.
Nun werden mir alle Bezeichnungen mit der fraglichen SN in ein Array gelesen.
Hier beginnt das Prob, dass mir da auch doppelte Bezeichnungen angezeigt werden. Diese will ich nun eliminieren und alle Bezeichnungen nur einmal in einem anderne Array speichern, damit ich dann später in einem Auswahlmenu darauf zurückgreifen kann.

Danke schon einmal für Deine Unterstützung. Gruß, Hardy


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Ulf
Geschrieben am: 27.08.2004 19:39:34

Wenn die Daten ohnehin schon in der Tabelle stehen, bietet sich doch an, Doppler mittels
Spezialfilter zu eleminieren.

Ulf


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: mealone
Geschrieben am: 27.08.2004 22:40:09

hallo hardy,

probier mal das hier
das ergebniss ist ein neuer array(ARR2) der jeden wert nur einmal enthält

Sub Test()
Dim ARR1, ARR2
ARR1 = Array("TEST0", "TEST0", "TEST6", "TEST3", "TEST7", "TEST6")
ARR2 = Array("")
ReDim Preserve ARR1(UBound(ARR1))
For Count1 = LBound(ARR1) To UBound(ARR1)
    Varic = ARR1(Count1)
        If InStr(VariN, Varic) > 0 Then
        Else
            VariN = CStr(VariN) & "," & CStr(Varic)
            VariNAnz = VariNAnz + 1
            If Left(VariN, 1) = "," Then
            VariN = Right(VariN, Len(VariN) - 1)
            End If
        End If
Next Count1
ReDim Preserve ARR2(VariNAnz - 1)
For Count2 = 0 To VariNAnz - 1
    If InStr(VariN, ",") > 0 Then
        ARR2(Count2) = Left(VariN, InStr(VariN, ",") - 1)
            VariN = Right(VariN, Len(VariN) - InStr(VariN, ","))
    Else
        ARR2(Count2) = VariN
    End If
Next Count2
End Sub


anm. die anzahl der werte in arr1 sind beliebig

gruss mealone


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: nighty
Geschrieben am: 28.08.2004 14:16:07

hi mealone :)

sieht ja nett aus das makro,so werd ich es wohl in einer mußestunde zerpfluecken muessen.die art der arraybildung kenne ich noch nicht,keine dimensionierung ?,was waeren dann die vorteile gegenueber alter arraybildung wie z.b.(dim test(2,2,2)).

gruss nighty


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: mealone
Geschrieben am: 28.08.2004 16:20:09

hallo nighty,

die eindeutige dimensionierung war früher glaub ich unumgänglich,
hier existiert sie im prinzip auch, wenn auch nicht sofort zu erkennen
hauptgrund für diesen weg ist flexibilität

bsp. beim ARR2 mit
ReDim Preserve ARR2(VariNAnz - 1)
das war nötig weil mann ja vorher nicht weiss wieviele werte aus ARR1 übrigbleiben

gruss mealone

anm.
im übrigen muss ich zu meiner schande gestehen das ich bei meinen vba exkursen nicht wirklich der perfektionist bin sondern eher zielorientiert arbeite, und das nach möglichkeit mit grösstmöglicher flexibilität
ich denke auch das vba cracks hier den code bestimmt noch optimieren könnten


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: nighty
Geschrieben am: 28.08.2004 21:42:32

hi mealone :)

schoenen dank nochmal,werd ich auf jedenfall mit experimentieren :))

gruss nighty

p.s.
uebrigens ein cooler nickname :)


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Hardy
Geschrieben am: 29.08.2004 12:20:24

Hi!
Vielen Dank mealone. Bin zwar leider noch nicht zum testen gekommen, werde es aber noch schnellstmöglichst nachholen.

Bis dann, Hardy


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Hardy
Geschrieben am: 29.08.2004 12:55:46

Hi mealone.

Irgendwie stehe ich noch auf dem Schlauch....

Dein Code funktionioert, kein Problem. Allerdings steige ich da noch nicht ganz durch. Wollte das arr1 dynamisch mit for...next us. befüllen, habe aber immer nur fehlermeldungen erhalten.
Solltest du irgendwie ein wenig Zeit übrig haben, würde ich Dich sonst bitten mir ein paar erklärende Zeilen dazu zu schicken, entweder hier oder unter s-hardy@gmx.de .
Vielen dank schon einmal, Haryd


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: mealone
Geschrieben am: 29.08.2004 13:41:37

hallo hardy,
wo kommen denn die daten/werte her ?

mealone


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: mealone
Geschrieben am: 29.08.2004 15:13:00

vielleicht hilft dir das ja schon
Sub Test()
Dim ARR1, ARR2
ARR1 = Array("")
ARR2 = Array("")
'#########ARR1 befüllen start############
VariAnz0 = 8 'hier woher auch immer die gesamt Anzahl der durchläufe
For Count0 = 0 To VariAnz0 - 1
    VariN0 = ActiveSheet.Cells(Count0 + 1, 2) ' dieser variablen solltest du deinen _
                                                wert übergeben (mein eintrag ist ein bsp)
    If InStr(VariN0, ",") > 0 Then
        ARR1(Count0) = Left(VariN0, InStr(VariN0, ",") - 1)
            VariN0 = Right(VariN0, Len(VariN0) - InStr(VariN0, ","))
    Else
        ARR1(Count0) = VariN0
    End If
ReDim Preserve ARR1(UBound(ARR1) + 1)
Next Count0
'#########ARR1 befüllen ende############
For Count1 = LBound(ARR1) To UBound(ARR1)
    Varic = ARR1(Count1)
        If InStr(VariN, Varic) > 0 Then
        Else
            VariN = CStr(VariN) & "," & CStr(Varic)
            VariNAnz = VariNAnz + 1
            If Left(VariN, 1) = "," Then
            VariN = Right(VariN, Len(VariN) - 1)
            End If
        End If
Next Count1
ReDim Preserve ARR2(VariNAnz - 1)
For Count2 = 0 To VariNAnz - 1
    If InStr(VariN, ",") > 0 Then
        ARR2(Count2) = Left(VariN, InStr(VariN, ",") - 1)
            VariN = Right(VariN, Len(VariN) - InStr(VariN, ","))
    Else
        ARR2(Count2) = VariN
    End If
Next Count2
End Sub


gruss mealone


  


Betrifft: AW: array sortieren und doppelte löschen danach zurück von: Hardy
Geschrieben am: 29.08.2004 17:47:15

Danke, werde das mit dem neuen Code mal probieren.
Bislang sah es bei mir so aus:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim geraet(100), auswahl(10) As String
Dim i, j, k, l, endzeile, endzeile2 As Integer
Dim flag, flag2 As Byte
Dim sn As String
'geänderte Zelle wird überprüft
If Target.Address = Range("snsuche").Address Then
    Sheets("karte").Range("a6:f300").Value = ""
    sn = Target.Value
    flag = 0
'Wenn Zielzelle leer ist dann wird die Tabelle gesäubert
    If sn = "" Then
        Sheets("karte").Range("a6:f300").Value = ""
        
    End If
'Auslesen der letzten zeile aus dem Blatt Lebenslauf
    endzeile = Sheets("lebenslauf").Range("a:a").End(xlDown).Row
    endzeile2 = Sheets("uebersicht").Range("a:a").End(xlDown).Row
'Überprüfung ob es die SN überhaupt gibt und Ausgabe der entsprechenden Daten
k = 6
'übung
l = 0
'alle gerätebezeihcnungen sind im array
    For i = 0 To 100
    geraet(i) = ""
    Next i
    For i = 0 To 10
    auswahl(i) = ""
    Next i
    
    
    For i = 1 To endzeile
        If Sheets("lebenslauf").Range("d" & i).Value = sn Then
          geraet(l) = Sheets("lebenslauf").Range("c" & i).Value
          l = l + 1
        End If
    Next i
'array auf doppelte einträge unteruschen
    
    auswahl(0) = geraet(0)
    For i = 1 To 100
       If geraet(i) <> "" Then
            flag = 0
            l = 0
            Do
                If auswahl(l) = geraet(i) Then
                    l = l + 1
                Else
                    For j = 1 To 10
                        If auswahl(j) <> "" Then
                        Else
                            flag = j
                            Exit For
                        End If
                    Next j
                    auswahl(flag) = geraet(i)
                    Exit Do
                End If
            
            Loop
        Else
        Exit For
        End If
    Next i
 
    
'kontrollanzeige geräte
    For i = 0 To 10
        If auswahl(i) <> "" Then
        MsgBox auswahl(i)
        Else
        Exit For
        End If
    Next i
'original
flag = 0
    For i = 1 To endzeile
        If Sheets("lebenslauf").Range("d" & i).Value = sn Then
            flag = 1
            Sheets("karte").Range("a" & k).Value = Sheets("lebenslauf").Range("a" & i).Value
            Sheets("karte").Range("b" & k).Value = Sheets("lebenslauf").Range("c" & i).Value
            Sheets("karte").Range("c" & k).Value = Sheets("lebenslauf").Range("e" & i).Value
            Sheets("karte").Range("d" & k).Value = Sheets("lebenslauf").Range("b" & i).Value
            Sheets("karte").Range("f" & k).Value = Sheets("lebenslauf").Range("f" & i).Value
            For j = 1 To endzeile2
                If Sheets("uebersicht").Range("a" & j).Value = Sheets("karte").Range("d" & k).Value Then
                    Sheets("karte").Range("e" & k).Value = Sheets("uebersicht").Range("b" & j).Value
                End If
            Next j
            k = k + 1
        End If
                
    Next i
    
    If flag = 0 Then
        MsgBox "Die angegebene Seriennummer existiert nicht!!", vbInformation, "Falsche Seriennummer"
    End If
    Range("A5:F22").Select
    Selection.sort Key1:=Range("A6"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("C2").Select
    
End If

End Sub



Es soll so sein, dass ich in dem Blatt "Lebenslauf" die gerätespezifischen Daten eingebe. Nun werden bei jedem Durchlauf in der Werkstatt immer neue Arbeiten am gleichen Gerät durchgeführt. Somit erscheint die Geraätebezeichnung mehr als einmal.
das Blatt "Karte" soll mir eine Übersicht über die an einem bestimmten Gerät durchgeführten arbeiten geben. Das bedeutet, dass ich als Suchkreterium die Seriennummer eingebe. Damit vergleicht er nun in dem Lebenslauf und sucht mir die passenden Geräte heraus. Diese gesamten Gerätebezeichnungen soll er mir nun in ein Array schreiben. Hier war/ist nun mein Problem, dass er mir alle gleichen Gerätebezeichnungen herausfiltern soll und die übrigen in ein neues/altes Array schreibt. Mit diesen neuen Werten will ich später in einem Userform Radiobuttons füttern - als Auswahloption.
Bald komme ich ins schleudern....

Danke Dir jedenfalls noch einmal recht herzlich. Deinen neuen Code werde ich asap ausprobieren.
Bis dann, Hardy


 

Beiträge aus den Excel-Beispielen zum Thema "array sortieren und doppelte löschen danach zurück"