MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 21.10.2017, 01:04   #1
PawelPopolski
MOF Profi
MOF Profi
Standard Excel2010 - Liste neu nummerieren

Hallo,

ich habe eine Liste, in der Inhalte nach Wichtigkeit sortiert sind. Die Wichtigkeit wird einfach anhand einer Nummer in der ersten Spalte der Tabelle dargestellt.

Gebe ich nun Daten in eine neue Zeile ein und stelle fest, dass diese Zeile die höchste Wichtigkeit besitzt, muss ich natürlich eine 1 in die erste Spalte schreiben. Der nächste Schritt wäre eine aufsteigende Sortierung nach dieser Spalte um die richtige Reihenfolge herzustellen.

Problem:
Wie nummeriere ich die vorhandenen Werte automatisch um?
Neue 1 soll bleiben, alle anderen Werte sollen entsprechend um 1 erhöht werden.

Das Ganze muss natürlich auch mit anderen Zahlen in der vorhandenen Reihe funktionieren.

Hat jemand eine Idee, wie ich das mit VBA lösen könnte?

__________________

Gruß,
Pawel Popolski


Logik hat immer ein eindeutiges Ergebnis, folgt aber nicht zwingend einem eindeutigen Weg.
PawelPopolski ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.10.2017, 02:05   #2
Oge
MOF User
MOF User
Standard

Hallo Pawel,

hier wie gewünscht ein Makrovorschlag für neue Einträge.

Falls du aber auch für vorhandene Einträge die Wichtigkeit ändern willst, ohne dass sich die letzten Nummern immer erhöhen, muss das Makro noch angepasst werden.
Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngZeile As Long
Dim lngTZeile As Long
Dim lngLZeile As Long
Dim lngWert As Long
Dim varListe As Variant
If Not (Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1) Then
    If IsNumeric(Target.Value) Then
        lngWert = Target.Value
        If lngWert > 0 Then
            Application.EnableEvents = False
            lngLZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            lngTZeile = Target.Row
            varListe = Range("A1:A" & lngLZeile).Value
            For lngZeile = 2 To lngLZeile
                If lngZeile <> lngTZeile And IsNumeric(varListe(lngZeile, 1)) Then
                    If varListe(lngZeile, 1) >= lngWert Then
                        varListe(lngZeile, 1) = varListe(lngZeile, 1) + 1
                    End If
                End If
            Next lngZeile
            Range("A1:A" & lngLZeile).Value = varListe
            Application.EnableEvents = True
        End If
    End If
End If
End Sub
Angehängte Dateien
Dateityp: xlsm Wichtigkeit.xlsm (15,3 KB, 2x aufgerufen)

__________________

helmut

Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität.
Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.10.2017, 07:29   #3
Hajo_Zi
MOF Guru
MOF Guru
Standard

starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.

wie gewünscht wurde das Makro erstellt. Wird die Nummer 4 durch 1 ersetzt, fehlt in der Liste 5

Code:

Option Explicit

Private Sub Worksheet_change(ByVal Target As Range)
    If Target.Column = 1 Then
        Application.EnableEvents = False
        Dim LoLetzte As Long
        Dim LoI As Long
        LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        For LoI = 1 To LoLetzte
            If Cells(LoI, 1) >= Target And LoI <> Target.Row Then
                Cells(LoI, 1) = Cells(LoI, 1) + 1
            End If
        Next LoI
        Application.EnableEvents = True
    End If
End Sub
GrußformelHomepage

__________________

Signatur in jedem Beitrag
In diesem Forum, kann der Beitrag als gelöst gekennzeichnet werde (unten Links). Bitte macht dies. Damit es auch in der Forumsübersicht gekennzeichnet ist.
Bitte Version angeben. Bei keiner Angabe gehe ich von meinen Angaben aus.
Betriebssystem: Windows 10 - 64 Bit, Office 2016 - 32 Bit.
Hajo_Zi ist gerade online  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.10.2017, 10:48   #4
PawelPopolski
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Hallo,

erst einmal tausend Dank für eure Hilfe.
Ich habe den Code ein wenig angepasst, damit es keine Lücken in der Nummerierung gibt. Hierzu sortiere ich nach der Änderung der Nummern die Tabelle nach der ersten Spalte und vergebe dann fortlaufend neue Zahlen für die erste Spalte. Die Zahl ergibt sich aus der Zeilennummer -4, da meine Werte in Zeile 5 beginnen.
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long      'RowCounter
Dim lngTRow As Long     'Target row
Dim lngFRow As Long     'first row
Dim lngLRow As Long     'last row
Dim lngValue As Long    'Target value
Dim varList As Variant  'List of values in range
Dim lngNew As Long      'new number
Dim rng As Range

lngFRow = 5

   If Not (Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1) Then
        If IsNumeric(Target.Value) Then
            lngValue = Target.Value
            If lngValue > 0 Then
                Application.EnableEvents = False
                lngLRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                lngTRow = Target.Row
                Set rng = Range("A1:A" & lngLRow)
                varList = rng.Value
                For lngRow = lngFRow To lngLRow
                    If lngRow <> lngTRow And IsNumeric(varList(lngRow, 1)) Then
                        If varList(lngRow, 1) >= lngValue Then
                            varList(lngRow, 1) = varList(lngRow, 1) + 1
                        End If
                    End If
                Next lngRow
                rng.Value = varList
                Set rng = Range(ActiveSheet.ListObjects(1))
                With ActiveSheet
                    .Range(rng.Address).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlYes
                End With
                For lngRow = lngFRow To lngLRow
                    Cells(lngRow, 1).Value = lngRow - lngFRow + 1
                Next lngRow
                Application.EnableEvents = True
            End If
        End If
    End If

End Sub
Es funktioniert, geht aber vielleicht auch eleganter?`

Und leider habe ich immer noch ein kleines Problem:
Füge ich eine neue Zeile an, wird sie ihrer Nummer entsprechend einsortiert.
Ändere ich eine "hohe" Zahl in eine kleinere, wird auch alles wie gewollt angepasst.
Ändere ich aber eine "kleine" Zahl in eine höhere gibt es einen Schönheitsfehler, der bei der gewählten vorgehensweise logisch ist. Wenn ich z.B. die Reihenfolge 1,2,3,4,5,6,7 habe und dann aus der 2 die 4 machen möchte, muss ich bei der entsprechenden Zeile eine 5 eingeben, damit sie an die richtige Stelle rückt.

Lange Rede kurzer Sinn:
Gibt es in Excel, ähnlich wie in Access, so etwas wie oldValue, um den aktuellen Wert einer Zelle automatisch zwischenzuspeichern?

Wenn ja, wie heisst der Befehl.
Wenn nein, wie könnte ich das bewerkstelligen?

__________________

Gruß,
Pawel Popolski


Logik hat immer ein eindeutiges Ergebnis, folgt aber nicht zwingend einem eindeutigen Weg.
PawelPopolski ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.10.2017, 23:06   #5
Oge
MOF User
MOF User
Standard

Hallo Pawel,

da du ja nach jeder Änderung die Liste sortierst, kannst du doch anhand der Position der geänderten Zelle entscheiden:

a) Vor der Position der geänderten Zelle werden alle Werte >= dem neuen Wert erhöht.
b) Nach der Position der geänderten Zelle werden alle Werte > dem neuen Wert erhöht.

__________________

helmut

Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität.
Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 22.10.2017, 09:19   #6
PawelPopolski
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Hallo Helmut,

etwas in der Art hatte ich schon versucht, aber irgendwie ist da noch ein kleiner gordischer Knoten, der zerschlagen werden muss. Ich werde mal weiter probieren. Wird schon irgendwie werden. :-)

Nochmal vielen Dank für die Hilfe.

__________________

Gruß,
Pawel Popolski


Logik hat immer ein eindeutiges Ergebnis, folgt aber nicht zwingend einem eindeutigen Weg.
PawelPopolski ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:57 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.