Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1356to1360
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

Codes einsortieren

Codes einsortieren
22.04.2014 17:05:37
Markus
Hallo Leute,
habe folgendes Problem, das meine Fähigkeiten übersteigt.
Ich habe eine Spalte voller Codes die ich in "Boxen" sortieren muss. Jeder Code soll X-mal (z.B. 7)nebeneinander in der nur EINER Box im gesamten Tabellenblatt auftauchen und die Box soll mit Codes vollständig gefüllt werden.
Diese Boxen haben immer den gleichen Kopf (Storage Place etc.) und der Kopf ist immer in der selben Position zur Position A1 der Box. Die Boxen selbst können jedoch in unterschiedlichen Tabellenblättern unterschiedliche Dimensionen haben ZxY (14x14, 8x12, etc). Von den exakt gleichen Boxen gibt es pro Blatt verdammt viele.
Beispieldatei hier (https://www.herber.de/bbs/user/90299.xlsx)
Ich hatte hier vor einer ganzen Weile von Franc großartige Hilfe wodurch ich die Boxen zumindest definieren kann:
  • 
    Sub Boxen_fuellen()
    Dim strProbe As String, SP_Spalte As Double, dPosZahl As Double, dPosBuchstabe As Double, dEnde  _
    _
    As Double, d_Spalte As Double
    Dim SP, Probe, SP_ersteAdresse As String, Probe_ersteAdresse As String, i As Double, j As  _
    Double, strGefunden As String, strGefunden2 As String
    Dim StrSP_Zeile As String, strSP_Spalte As String, varSP_Zeile As Variant, varSP_Spalte As  _
    Variant
    Dim strBereich As String, strZelle1 As String, strZelle2 As String, blProbe As Boolean
    Dim strID As String
    'vollständig variables System - alles wird ausgehend von der Zelle "Storage Place" bestimmt
    'dadurch ist es wirklich egal wo dieses Boxsystem steht - kann auch x mal nebeneinander stehen   _
    _
    ect.
    'Abstände definieren - Ausgangspunkt ist die Zelle wo jeweils "Storage Place" steht
    d_Spalte = 13 ' Letzte Spalte von Storage Place aus gesehen
    dPosZahl = 4 ' wenn Storage Place gefunden wird ist 4 Zeilen drunter die Position
    dPosBuchstabe = "-1" ' Buchstaben liegen 1 Spalte links von Storage Place
    dEnde = 18 ' Storage Place bis "N"
    dBoxNamen = 4 ' Bezeichnungen der Box liegen in der 4. Spalte neben Storage Place
    dBlatt = 1 ' in welchem Blatt liegen die Daten
    With ThisWorkbook.Sheets(dBlatt).UsedRange ' im genutzten Arbeitsbereich suchen
    Set SP = .Find(What:="Storage Place", LookIn:=xlValues) ' nach "Storage Place"
    If Not SP Is Nothing Then
    SP_ersteAdresse = SP.Address
    Do
    StrSP_Zeile = StrSP_Zeile & " " & SP.Row ' alle Zeilen wo Storage Place gefunden  _
    wird mit Leerzeichen getrennt notieren
    strSP_Spalte = strSP_Spalte & " " & SP.Column ' Spalte merken
    Set SP = .FindNext(SP)
    Loop While Not SP Is Nothing And SP_ersteAdresse  SP.Address
    End If
    End With
    Set SP = Nothing
    End Sub
    

  • Ich habe leider keine Ahnung wie ich ein Makro zustande bringe, das die Spalte im Blatt 2 durcharbeitet und die Boxen füllt. Eine Überprüfung ob ein Code in dem Blatt schon in einer Box vorhanden ist ist nicht zwingend nötig, da ich die Liste immer neu generiere, wenn einfach möglich aber fein.
    Kann mir da jemand helfen?
    Vielen Dank im Vorraus!
    Markus

    7
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Codes einsortieren
    23.04.2014 09:27:23
    fcs
    Hallo Markus,
    deine Beschreibung ist leider nicht nachvollziehbar.
    Ich habe eine Spalte voller Codes die ich in "Boxen" sortieren muss.
    Was sind die Sortierkriterien?
    Oder willst du die Codes "nur" auf die Boxen verteilem?
    Jeder Code soll X-mal (z.B. 7)nebeneinander in der nur EINER Box im gesamten Tabellenblatt auftauchen und die Box soll mit Codes vollständig gefüllt werden.
    "Jeder Code soll X-mal (z.B. 7)nebeneinander.": Wie wird X ermittelt, soll hier eine Eingabemöglichkeit vorgesehen werden?
    " in der nur EINER Box im gesamten": Was ist damit gemeint?
    "und die Box soll mit Codes vollständig gefüllt werden." Soll eine Box nach der anderen komplett befüllt werden? In welcher Reihenfolge? links-nach-rechts, oben-nach-unten?
    Diese Boxen haben immer den gleichen Kopf (Storage Place etc.) und der Kopf ist immer in der selben Position zur Position A1 der Box.Das hab ich verstanden.
    Die Boxen selbst können jedoch in unterschiedlichen Tabellenblättern unterschiedliche Dimensionen haben ZxY (14x14, 8x12, etc). Von den exakt gleichen Boxen gibt es pro Blatt verdammt viele.
    Was soll pasieren, wenn alle Boxen eine sBlatts befüllt sind, aber noch nicht alle Codes verteilt/esortiert sind?
    Ich habe leider keine Ahnung wie ich ein Makro zustande bringe, das die Spalte im Blatt 2 durcharbeitet und die Boxen füllt.
    Wenn die Fragen oben geklärt sind, dann kommt man da sicher weiter.
    Eine Überprüfung ob ein Code in dem Blatt schon in einer Box vorhanden ist ist nicht zwingend nötig, da ich die Liste immer neu generiere, wenn einfach möglich aber fein.
    In deiner Beispielmappe gibt es keine Codes mehrfach. Da ist eine Prüfung doch sowieso überflüssig.
    Hilfreich wäre es, wenn du beispielhaft mal ca. 20 Codes in Boxen eingeträgst. Ein Bild sagt mehr als 1000 Worte!
    Gruß
    Franz

    Anzeige
    AW: Codes einsortieren
    23.04.2014 09:27:27
    Tino
    Hallo,
    ich verstehe nicht wie das Muster für die sortierung ist.
    Also welche Daten warum in welche Box?
    Gruß Tino

    AW: Codes einsortieren
    24.04.2014 10:02:01
    fcs
    Hallo Markus,
    hier ein Makro zum Ausfüllen der Boxen eines Tabellenblattes.
    Gruß
    Franz
    'vor dem Start des Makros das Blatt mit Boxen wählen, das ausgefüllt werden soll
    Sub Codes_einsortieren_02()
    Dim wksImport As Worksheet, wksBox As Worksheet
    Dim ZeileCode As Long
    Dim ZelleA1 As Range, rngBox As Range, arrBox() As Range, intBox As Integer
    Dim BoxSpalte As Long, BoxSpalten As Long, BoxZeilen As Long
    Dim rngCode As Range, intCode As Integer, Anzahl_X As Integer
    Dim strAdresseBox1 As String
    Set wksImport = ActiveWorkbook.Worksheets("Kontrolle_Import")
    Set wksBox = ActiveSheet
    With wksBox
    Set rngBox = .Cells.Find(What:="Storage Place", after:=.Cells(1, 1), LookIn:=xlValues, _
    lookat:=xlWhole, searchorder:=xlByRows)
    If Not rngBox Is Nothing Then
    'zelladresse der 1. Box merken
    strAdresseBox1 = rngBox.Address
    Set ZelleA1 = rngBox.Range("A1").Offset(5, 0)
    'Anzahl der Spalten der Boxen ermitteln
    intBox = 0: BoxSpalten = 0
    Do Until ZelleA1.Offset(-1, intBox) = ""
    BoxSpalten = BoxSpalten + 1
    intBox = intBox + 1
    Loop
    'Anzahl der Zeilen der Boxen ermitteln
    intBox = 0: BoxZeilen = 0
    Do Until ZelleA1.Offset(intBox, -1) = ""
    BoxZeilen = BoxZeilen + 1
    intBox = intBox + 1
    Loop
    'Anzahl der Boxen ermitteln und Zellen mit "Storage Place" in Array merken
    intBox = 0
    Do
    intBox = intBox + 1
    ReDim Preserve arrBox(1 To intBox)
    Set arrBox(intBox) = rngBox.Range("A1")
    Set rngBox = .Cells.FindNext(after:=rngBox)
    Loop Until rngBox.Address = strAdresseBox1
    'Anzahl der Codewiederholungen eingeben
    Anzahl_X = Application.InputBox(Prompt:="Anzahl Codewiederholungen je Zeile?", _
    Title:="Anzahl Code-Wiederholungen", Default:=BoxSpalten / 2, Type:=1)
    If Anzahl_X = 0 Or Anzahl_X > BoxSpalten Then
    MsgBox "Unzulässiger Wert für ANzahl Code-Wiederholungen"
    GoTo Beenden
    End If
    'Codes im Importblatt abarbeiten
    Application.ScreenUpdating = False
    With wksImport
    intBox = 1
    BoxSpalte = 0
    Set ZelleA1 = arrBox(intBox).Range("A1").Offset(5, 0)
    For ZeileCode = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Step BoxZeilen
    Set rngCode = .Range(.Cells(ZeileCode, 1), .Cells(ZeileCode + BoxZeilen - 1, 1))
    For intCode = 1 To Anzahl_X
    ZelleA1.Offset(0, BoxSpalte).Resize(BoxZeilen, 1).Value = rngCode.Value
    BoxSpalte = BoxSpalte + 1
    If BoxSpalte = BoxSpalten Then
    'Box ist voll - nächste Box setzen und Spaltenzähler zurücksetzen
    intBox = intBox + 1
    BoxSpalte = 0
    If intBox > UBound(arrBox) Then
    MsgBox "Alle Boxen im Blatt """ & wksBox.Name & """ sind gefüllt!"
    GoTo Beenden
    End If
    Set ZelleA1 = arrBox(intBox).Range("A1").Offset(5, 0)
    End If
    Next intCode
    Next ZeileCode
    End With
    Else
    MsgBox "In Blatt """ & wksBox & """ gibt es keinen Eintrag ""Storage Place""!"
    End If
    End With
    Beenden:
    Application.ScreenUpdating = True
    End Sub
    

    Anzeige
    AW: Codes einsortieren
    24.04.2014 14:55:32
    Markus
    Hallo Franc!
    Ich muss erneut meinen Hut ziehen. Hatte nebenher probiert es über eine andere Strategie auf reiner Excelbasis zu lösen... war noch nicht annähernd fertig.
    Vielen Dank für das Makro! Es funktioniert super, hat aber ein Manko, von dem ich hoffe es ist einfach zu beheben. Wenn man z.Bsp. 3 Code Wiederholungen angibt, werden (bei den 14x14 Boxen) die Kisten korrekt gefüllt, da jedoch 14 nicht durch 3 teilbar ist liegen von den letzten 14 Proben die jeweils 2 letzten in einer neuen Box. Das ist in der Praxis höchst ungewollt. Ich denke es liegt daran, dass die Befüllung der Boxen Spaltenweise (A1-A3; B1-B3;...) befüllt werden. Wenn man es Zeilenweise machte (A1-A3; A4-A6;...), müsste sich dieses Problem eigentlich beheben, oder?
    Beste Grüße
    Markus

    Anzeige
    AW: Codes einsortieren
    25.04.2014 23:27:16
    fcs
    Hallo Markus,
    auch wenn die Codes zeilenweise einträgt kann es passieren, dass 1 Code in 2 Boxen eingetragen wird, wenn die Gesamtzellen-Zahl der Box nur mit Rest durch die Zahl der Wiederholungen dividiert werden kann.
    Nachfolgend das entsprechend angepasste Makro.
    Gruß
    Franz
    Sub Codes_einsortieren()
    Dim wksImport As Worksheet, wksBox As Worksheet
    Dim ZeileCode As Long, varCode As Variant
    Dim ZelleA1 As Range, rngBox As Range, arrBox() As Range, intBox As Integer
    Dim BoxSpalte As Long, BoxZeile As Long, BoxSpalten As Long, BoxZeilen As Long
    Dim intCode As Integer, Anzahl_X As Integer
    Dim strAdresseBox1 As String
    Set wksImport = ActiveWorkbook.Worksheets("Kontrolle_Import")
    Set wksBox = ActiveSheet
    With wksBox
    Set rngBox = .Cells.Find(What:="Storage Place", after:=.Cells(1, 1), LookIn:=xlValues, _
    lookat:=xlWhole, searchorder:=xlByRows)
    If Not rngBox Is Nothing Then
    'zelladresse der 1. Box merken
    strAdresseBox1 = rngBox.Address
    Set ZelleA1 = rngBox.Range("A1").Offset(5, 0)
    'Anzahl der Spalten der Boxen ermitteln
    intBox = 0: BoxSpalten = 0
    Do Until ZelleA1.Offset(-1, intBox) = ""
    BoxSpalten = BoxSpalten + 1
    intBox = intBox + 1
    Loop
    'Anzahl der Zeilen der Boxen ermitteln
    intBox = 0: BoxZeilen = 0
    Do Until ZelleA1.Offset(intBox, -1) = ""
    BoxZeilen = BoxZeilen + 1
    intBox = intBox + 1
    Loop
    'Anzahl der Boxen ermitteln und Zellen mit "Storage Place" in Array merken
    intBox = 0
    Do
    intBox = intBox + 1
    ReDim Preserve arrBox(1 To intBox)
    Set arrBox(intBox) = rngBox.Range("A1")
    Set rngBox = .Cells.FindNext(after:=rngBox)
    Loop Until rngBox.Address = strAdresseBox1
    'Anzahl der Codewiederholungen eingeben
    Anzahl_X = Application.InputBox(Prompt:="Anzahl Codewiederholungen je Zeile?", _
    Title:="Anzahl Code-Wiederholungen", Default:=BoxSpalten / 2, Type:=1)
    If Anzahl_X = 0 Or Anzahl_X > BoxSpalten Then
    MsgBox "Unzulässiger Wert für ANzahl Code-Wiederholungen"
    GoTo Beenden
    End If
    'Codes im Importblatt abarbeiten
    Application.ScreenUpdating = False
    With wksImport
    intBox = 1
    BoxZeile = 0
    BoxSpalte = 0
    Set ZelleA1 = arrBox(intBox).Range("A1").Offset(5, 0)
    For ZeileCode = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
    varCode = .Cells(ZeileCode, 1)
    For intCode = 1 To Anzahl_X
    ZelleA1.Offset(BoxZeile, BoxSpalte).Value = varCode
    BoxSpalte = BoxSpalte + 1
    If BoxSpalte = BoxSpalten Then
    'Zeile ist voll
    BoxSpalte = 0
    BoxZeile = BoxZeile + 1
    If BoxZeile = BoxZeilen Then
    'Box ist voll - nächste Box setzen und Zeilen-/SPaltenzähler zurücksetzen
    intBox = intBox + 1
    BoxZeile = 0
    BoxSpalte = 0
    If intBox > UBound(arrBox) Then
    MsgBox "Alle Boxen im Blatt """ & wksBox.Name & """ sind gefüllt!"
    GoTo Beenden
    End If
    Set ZelleA1 = arrBox(intBox).Range("A1").Offset(5, 0)
    End If
    End If
    Next intCode
    Next ZeileCode
    End With
    Else
    MsgBox "In Blatt """ & wksBox & """ gibt es keinen Eintrag ""Storage Place""!"
    End If
    End With
    Beenden:
    Application.ScreenUpdating = True
    End Sub
    

    Anzeige
    AW: Codes einsortieren
    24.04.2014 12:09:33
    Tino
    Hallo,
    habe auch mal was eingebaut, vielleicht geht es ja so.
    Die Datei muss aber eine xlsm sein, xlsx kann kein VBA.
    https://www.herber.de/bbs/user/90337.xlsm
    Gruß Tino

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige