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 CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Daten sortieren | Herbers Excel-Forum


Betrifft: Daten sortieren von: René
Geschrieben am: 27.04.2011 10:41:27

Hallo liebe Excelgemeinde,

ich habe ein Makro mit dem ich Dateien in zwei verschiedenen Ordnern suche und in einer Tabelle auflisten lassen.

Das Makro sieht wie folgt aus

Private Sub CommandButton4_Click()
Dim strDatei As String, strVerzeichnis As String, lngZ As Long
  
  With ActiveSheet
    '1 -------------------------------------------------------------------------------
    strVerzeichnis = "Y:\Epikrisen_2011\"
    
    If Dir(strVerzeichnis, vbDirectory) = "" Then
      MsgBox strVerzeichnis & " wurde nicht gefunden!" & Space(10), 64, "weise hin..."
      Exit Sub
    End If
    
    .Columns(1).ClearContents
    
    strDatei = Dir(strVerzeichnis & "*" & Cells(3, 3) & "*.xls", vbNormal)
    
    If Dir(strVerzeichnis & "*" & Cells(3, 3) & "*.xls", vbNormal) = "" Then
      MsgBox ("Für diese Auswahl liegen keine erfassten Epikrisen vor!")
    End If
    
    Do While strDatei <> ""
      lngZ = lngZ + 1
      .Hyperlinks.Add Anchor:=.Cells(lngZ, 1), _
        Address:=strVerzeichnis & strDatei, SubAddress:="", _
        TextToDisplay:=strDatei
      strDatei = Dir
    Loop
    
    '2 -------------------------------------------------------------------------------
    strVerzeichnis = "Y:\Rückmeldungen\"
    
    If Dir(strVerzeichnis, vbDirectory) = "" Then
      MsgBox strVerzeichnis & " wurde nicht gefunden!" & Space(10), 64, "weise hin..."
      Exit Sub
    End If
    
    .Columns(5).ClearContents
    
    strDatei = Dir(strVerzeichnis & "*" & Cells(10, 3) & "*.msg", vbNormal)
    
    If Dir(strVerzeichnis & "*" & Cells(10, 3) & "*.msg", vbNormal) = "" Then
      MsgBox ("Für diese Epikrisen liegen keine Rückmeldungen vor!")
    End If
    
    Do While strDatei <> ""
      lngZ = lngZ + 1
      .Hyperlinks.Add Anchor:=.Cells(lngZ, 5), _
        Address:=strVerzeichnis & strDatei, SubAddress:="", _
        TextToDisplay:=strDatei
      strDatei = Dir
    Loop
    
  
  
    Dim oOle As OLEObject
    For Each oOle In ActiveSheet.OLEObjects
      If LCase(oOle.Name) Like "commandbutton*" Then
        Select Case CInt(Replace(LCase(oOle.Name), "commandbutton", ""))
          Case 1 To 4
            
            oOle.Visible = False
        End Select
      End If
    Next

    Range("A1").Select
        
    
  End With
End Sub
Nun möchte ich erreichen, dass nach dem Auflisten eine Sortierung erfolgt.

zum Beispiel

Spalte A Zeile 1: Epikrise_Nummer_1_vom 15.04.2011 Spalte E Zeile 1: Rückmeldung zu Epikrise_Nummer_1

und die Zeilen in Spalte E leer bleiben wenn es keine Rückmeldung zur Epikrise gibt

Kann man das realisieren???? Hab lange probiert aber keinen Plan.

  

Betrifft: AW: Daten sortieren von: René
Geschrieben am: 27.04.2011 13:09:35

Hallo,

ein Ansatz wäre vielleicht dieses Makro

Aber ich müsste mit der Ersetzen Funktion meinen Text "Nummer_1" im Dateiname ausfiltern und da funzt auch diese Sache nicht weil dann eben eine Formel in der Suchzelle steht. Mist.
Habt ihr noch eine Idee???
MfG René

Private Sub CommandButton1_Click()
Dim z As Long
Dim ws As Worksheet
Set ws = Worksheets("Tabelle1")
anzA = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim spalte As Long
For spalte = 2 To 242 Step 2
anzB = ws.Cells(Rows.Count, spalte).End(xlUp).Row
If ws.Cells(Rows.Count, spalte + 1).End(xlUp).Row = 1 Then
ze = ws.Cells(Rows.Count, spalte + 1).End(xlUp).Row + 1
End If
For z = 2 To anzB
suchzahl = ws.Cells(z, spalte)
With ws.Range("a2:a" & anzA)
    Set c = .Find(suchzahl, LookIn:=xlValues, LookAt:=xlWhole)
    If c Is Nothing Then
        ws.Cells(ze, spalte + 1) = suchzahl
        ws.Cells(z, spalte) = ""
        ze = ws.Cells(Rows.Count, spalte + 1).End(xlUp).Row + 1
    End If
End With
Next z
anzB = ws.Cells(Rows.Count, spalte).End(xlUp).Row
ws.Range(Cells(2, spalte), Cells(anzB, spalte)).Copy ws.Range("IV2")
ws.Range(Cells(2, spalte), Cells(anzB, spalte)).ClearContents
Dim y As Long
Dim suche As String
For y = 2 To anzB
  If Cells(y, 256).Value <> "" Then
     suche = Cells(y, 256).Value
     With ws.Range("A2:A" & anzA)
      Set x = .Find(what:=suche, LookIn:=xlValues, LookAt:=xlWhole)
      If Not x Is Nothing Then
         Dim reihe As Long
         reihe = x.Row
         Cells(reihe, spalte).Value = suche
         ws.Cells(y, 256) = ""
      End If
     End With
  End If
Next y
Next spalte
End Sub



  

Betrifft: AW: Daten sortieren von: Dirk aus Dubai
Geschrieben am: 27.04.2011 15:30:12

Hallo!

Wie sehen denn Deine gesammelten Eintraege in Spalte A und Spalte E aus? Welche struktur haben die Werte?
Zeige doch mal ein representatives Beispiel.

Gruss

Dirk aus Dubai


  

Betrifft: AW: Daten sortieren von: René
Geschrieben am: 27.04.2011 16:21:20

Hallo Dirk,

das Problem habe ich inzwischen sehr sehr aufwendig gelöst. Ich stelle morgen mal für alle eine Beispieldatei ein. Vielleicht kann man ja doch noch was verbessern oder vielleicht kann es auch jemand für sich nutzen. Muss die Datei aber dazu abspecken und paar vertrauliche Daten rausnehmen. Aber es funzt jetzt erst mal. Also bis morgen

Was macht Dubai????
Warste Ostern in Germany????

Sei gegrüßt aus Sachsen
René


  

Betrifft: AW: Daten sortieren von: René
Geschrieben am: 29.04.2011 23:00:45

erledigt


Beiträge aus den Excel-Beispielen zum Thema "Daten sortieren"