kleine & sicherlich leicht lösbare XL Funktionen



Excel-Version: 8.0 (Office 97)
nach unten

Betrifft: kleine & sicherlich leicht lösbare XL Funktionen
von: sunny8 (beginner)
Geschrieben am: 26.05.2002 - 13:47:14

sunny8_de@gmx.de

Hallo.

Ich habe mal wieder einige kleine Funktionen zu lösen, für die ich mich mal wieder zu dumm anstelle. Ich hoffe, dass ihr mir weiterhelfen könnt und ich dann hoffentlich auch daraus lernen kann und beim nächsten Mal dann selbst hier auf der Plattform als Helfender tätig werden kann.
okay, nun zu den kleinen Herausforderungen, die nacheinander mittels eines Add-Ins oder manuell zu startendem Makros an eine große Exceltabelle gestellt werden...

Grobübersicht: 1. ab einem bestimmten Eintrag in Spalte A alle
oberen Zellen löschen
2. Datensatznummerierung abwärts bis zum letzten Datensatz einfügen
3. ideale Spaltenbreite einfügen
4. gesamte Tabelle einrahmen (jede Zelle mit Umrahmung)

1. In der Spalte A soll abwärts bis zu einem Zelleneintrags namens "ID_1" gesucht werden. Ist dieser gefunden (meist in der Zeile 5-18 zu finden) sollen alle oberen Zeilen gelöscht/abgeschnitten werden.
2. Im Anschluß daran soll dann eine Spalte zwischen der bisherigen D und E eingefügt werden, in der eine Nummerierung abwärts von 1 bis x (solange bis keine Zeichenkette mehr in der jeweiligen Zeile gefunden wird - also nachschauen ob in A1 eine Zeichenkette, dann in neuer Spalte E eine 1, ist dann in A2 eine Zeichenkette enthalten, dann in E2 eine 2 einfügen und so weiter) eingefügt werden soll.
3. Als nächster Brocken für mich sollte dann die ideale Spaltenbreite angelegt werden, da alle Spalten in der Ausgangstabelle die selbe Spaltenbreite haben und viele der enthaltenen Texte nicht vollständig lesbar sind.
4. Im Anschluß daran soll die gesamte Tabelle eingerahmt werden. Hierzu müsste man also von A1 bis abwärts und seitswärts solange suchen bis kein Wert/Zeichenkette mehr gefunden wird und von da an nach oben und links jede Spalte einrahmen.
Sofern man bei Punkt 2 mit einem Array gearbeitet hat, könnte man auch diesen Wert gleich hier verwenden und müsste dann nur noch die max. belegte Spaltenzahl ermitteln.

Für mich ist dies alles recht kompliziert aber ich könnte mir gut vorstellen, dass dies für euch nur eine kleine Aufgabe zum Warmwerden ist. Ich würde mich riesig freuen, wenn ihr mir bei der Lösung aller 4 Teilbereiche helfen könntet, da ich die Lösung schnellstmöglichst bräuchte.
Ich hoffe, dass ich dann auch bald als Helfender hier "tätig" werden kann.

Vielen Dank für eure Mühe!!!!!!!!

euer Sunny8 :)

nach oben   nach unten

Re: kleine & sicherlich leicht lösbare XL Funktionen
von: RALF
Geschrieben am: 26.05.2002 - 14:24:47

zeichne Dir den ganzen Vorgang doch mal mit dem Makrorecorder auf ...die Bearbeitung nachher sollte einfach sein.

GRUß RALF


nach oben   nach unten

Re: kleine & sicherlich leicht lösbare XL Funktionen
von: sunny8 (beginner)
Geschrieben am: 26.05.2002 - 19:18:36

Die Idee ist gut aber ich denke, dass man beachten sollte, dass die Datei nicht nur 100 Datensätze beinhaltet und eine resourcenverbrauchende Prozedur á la Microsoft die Ausführzeit des Scriptes ansteigen lassen würde?!

nach oben   nach unten

Lösungsvorschlag
von: MikeS
Geschrieben am: 26.05.2002 - 19:33:48

Hi Sunny,

probier`s mal mit nachfolgendem Makro.

Achtung, ich bin davon ausgegangen, daß Du keine Spaltenüberschriften hast.


Sub FindenUndErsetzen()
    Dim iZähler As Long
    Application.ScreenUpdating = False
    ' "ID 1" suchen
    ActiveSheet.Range("A1").Select
        Do Until ActiveCell.Value = "ID 1"
            If ActiveCell.Value <> "ID 1" Then
            ActiveCell.Offset(1, 0).Select
            End If
        Loop
    
    ' alle Zeilen darüber löschen
        Do Until ActiveCell.Row = 1
            If ActiveCell.Row > 1 Then
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Delete
            End If
        Loop
    
    ' neue Spalte zwischen D und E einfügen
    ActiveCell.Offset(0, 4).Select
    Selection.EntireColumn.Insert
    
    ' Nummerrierung durchführen
    Range("a1").Select
    iZähler = 1
        Do Until ActiveCell.Value = ""
            If ActiveCell.Value <> "" Then
            ActiveCell.Offset(0, 4).Select
            ActiveCell.Value = iZähler
            ActiveCell.Offset(1, -4).Select
            iZähler = iZähler + 1
            End If
        Loop
    Application.ScreenUpdating = True
End Sub

Alles klar?

Ciao Mike


nach oben   nach unten

automatische Spaltenbreite
von: MikeS
Geschrieben am: 26.05.2002 - 20:06:29

Hallo Sunny,

ergänze bitte noch nachfolgende Codezeile für die automatische Spaltenbreite (vor "Application.ScreenUpdating = True")


ActiveSheet.Range("A:IV").Columns.AutoFit

Sorry, hatte ich in der Eile ganz vergessen.

Ciao MikeS

nach oben   nach unten

endgültige Fassung
von: MikeS
Geschrieben am: 27.05.2002 - 08:23:37

Hi Sunny,

hier nun der endgültige Code in dem auch berücksichtigt wird,
daß wenn kein "ID 1" gefunden wird, die Prozedur vorzeitig beendet wird.


Sub FindenUndErsetzen()
    Dim iZähler As Long
    Application.ScreenUpdating = False
    ' "ID 1" suchen
    ' Wenn "ID 1" nicht gefunden wird, dann Abbruch!
    ActiveSheet.Range("A1").Select
        Do Until ActiveCell.Value = ""
            If ActiveCell.Value <> "ID 1" Then
            ActiveCell.Offset(1, 0).Select
            Else
            Exit Do
            End If
        Loop
    
    ' alle Zeilen darüber löschen
        Do Until ActiveCell.Row = 1
            If ActiveCell.Value = "ID 1" And ActiveCell.Row > 1 Then
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Delete
            Else
            Exit Sub
            End If
        Loop
    
    ' neue Spalte zwischen D und E einfügen
    ActiveCell.Offset(0, 4).Select
    Selection.EntireColumn.Insert
    
    ' Nummerrierung durchführen
    Range("a1").Select
    iZähler = 1
        Do Until ActiveCell.Value = ""
            If ActiveCell.Value <> "" Then
            ActiveCell.Offset(0, 4).Select
            ActiveCell.Value = iZähler
            ActiveCell.Offset(1, -4).Select
            iZähler = iZähler + 1
            End If
        Loop
    ActiveSheet.Range("A:IV").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Ciao MikeS

nach oben   nach unten

SUPER!!! Vielen Dank für die Hilfestellung!!!
von: Sunny8
Geschrieben am: 27.05.2002 - 12:17:26

Hallo Mike.

Ersteinmal vielen vielen Dank für diesen "gutaussehenden" Code.
Ich habe ihn leider noch nicht testen können aber werde hoffentlich in den nächsten Stunden dazu kommen.
Ich melde mich dann nochmal.
Bis dann...

P.S. Danke für das mir verliehene Dauerlächeln! ;-)


nach oben   nach unten

für MikeS: um kleine Anpassung gebeten
von: Sunny8
Geschrieben am: 27.05.2002 - 14:25:30

Hallo Mike.

Ich habe den Code mal an meiner Tabelle getestet und kam zu folgendem Ergebnis. Alles scheint soweit perfekt zu laufen. Es muss lediglich ersteinmal nur eine kleine Änderungen gemacht werden.
So ist es wichtig, dass bei der Suche nach der Zeichenkette "ID 1" nicht nur nur solange gesucht wird, bis 1 leere Zeile kommt, sondern bis 2 aufeinanderfolgende Zeilen kommen.
Vielen Dank schonmal im Voraus!!!

Tschöö,
Marcel :-)

nach oben   nach unten

Re: für MikeS: um kleine Anpassung gebeten
von: MikeS
Geschrieben am: 27.05.2002 - 16:14:52

Hallo Sunny,

bitte nochmal um Erklärung.

Wie meinst Du das mit den zwei aufeinanderfolgenden Zeilen?
In beiden "ID 1" oder "" ???

Bitte Rückinfo, ciao MikeS


nach oben   nach unten

Re: für MikeS: um kleine Anpassung gebeten
von: Sunny
Geschrieben am: 28.05.2002 - 11:40:01

Hallo Mike.

Was ich mit meinem vorherigen Beitrag sagen wollte war, dass die Schliefe nicht solange suchen soll bis eine leere Zelle kommt, sondern bis 2 aufeinanderfolgende Zellen kommen.
Ich stelle mich nur wieder zu anfängerhaft dabei an. :(

Tschööö,
Sunny.

nach oben   nach unten

Suche bis 2Leerzellen untereinander
von: MikeS
Geschrieben am: 28.05.2002 - 13:09:36

Hi Sunny,

enstpricht das Deinen Vorstellungen?


Sub FindenUndErsetzen()
    Dim iZähler As Long
    Application.ScreenUpdating = False
    ' "ID 1" suchen
    ' Wenn "ID 1" nicht gefunden wird, dann Abbruch!
    ' Suche bis in Spalte A zwei Zellen untereinander leer sind
    ActiveSheet.Range("A1").Select
        Do Until ActiveCell.Value = "" And ActiveCell.Offset(1, 0).Value = ""
            If ActiveCell.Value <> "ID 1" Then
            ActiveCell.Offset(1, 0).Select
            Else
            Exit Do
            End If
        Loop
    
    ' alle Zeilen darüber löschen
        Do Until ActiveCell.Row = 1
            If ActiveCell.Value = "ID 1" And ActiveCell.Row > 1 Then
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Delete
            Else
            Exit Sub
            End If
        Loop
    
    ' neue Spalte zwischen D und E einfügen
    ActiveCell.Offset(0, 4).Select
    Selection.EntireColumn.Insert
    
    ' Nummerrierung durchführen
    Range("a1").Select
    iZähler = 1
        Do Until ActiveCell.Value = ""
            If ActiveCell.Value <> "" Then
            ActiveCell.Offset(0, 4).Select
            ActiveCell.Value = iZähler
            ActiveCell.Offset(1, -4).Select
            iZähler = iZähler + 1
            End If
        Loop
    ActiveSheet.Range("A:IV").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Ciao MikeS

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "kleine & sicherlich leicht lösbare XL Funktionen"