Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

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

einfachste Möglichkeit


Betrifft: einfachste Möglichkeit von: Christian
Geschrieben am: 24.09.2019 20:29:03

Hallo,

Ich wollte mal fragen, ob es für das was ich hier mache, auch schnellere Wege gibt, a ich das doch recht häufig mache.

1. sortiere ich Tabelle1 Spalte A von A bis Z.
2. 100 der Zeilen beginnen mit Ordnungszahlen von 1. bis 100. diese behalte ich, alle andere lösche ich.
3. Ich ersetze ". " durch "~".
4. Ich trenne den Text in Spalten mit Trennzeichen "~".
5. Ich lösche die erste Spalte mit den Zahlen.
6. Ich wende die Glätten Formel auf die übrig gebliebene Spalte an, da alle Texte ein Leerzeichen am Ende haben.
7. Ich kopiere die 100 Zellen mit der Glätten Formel und füge die Werte am Ende von Tabelle 3 Spalte A ein.
8. Ich entferne in der kompletten Tabelle 3 Spalte A Duplikate.
9. ich sortiere Tabelle3 Spalte A von A bis Z.

Wie gesagt gibt es da praktikablere Lösungen?`

Oder anders die Fragestellung aufgebaut, wie mache ich am einfachsten aus Tabelle 1 die Tabelle 3, wobei wenn ich das ganze wiederhole, indem ich andere Texte in Tabelle 1 einfüge, die neuen Texte unter die alten in Tabelle3 geschrieben werden sollen und dann Duplikate entfernt werden sollen.

https://www.herber.de/bbs/user/132177.xlsx

Danke
Christian

  

Betrifft: AW: einfachste Möglichkeit von: Piet
Geschrieben am: 24.09.2019 23:35:05

Hallo Christian

baue dir bitte in dein Beispiel, in ein normales Modul, diesen Code ein. Start ihn mit einem Button.
Ich hoffe das Makro erfüllt alle dein Wünsche. Würde mich freuen wenn es problemlos klappt.

mfg Piet

Option Explicit

Sub String_aufbereiten()
Dim AC As Variant, zx, lz As Integer
Worksheets("Tabelle1").Select
SpalteA_sortieren   'A sortieren

'Punkte Vorspann abschneiden
For lz = 1 To 100
   If Len(Cells(1, 1)) < 10 Then Rows(1).Delete
Next lz

'LastZell in Spalte A ermitteln
lz = Cells(Rows.Count, 1).End(xlUp).Row
'Alle Nummern 1.-100. abschneiden
For Each AC In Range("A1:A" & lz)
   If IsNumeric(Left(AC, 1)) Then
      AC.Value = Trim(Mid(AC, InStr(AC, " "), 100))
   Else   'restliche Zeilen löschen
      Cells(AC.Row, 1).Resize(lz, 1).Clear
   End If
Next AC

'LastZell in Spalte A + Tabelle 3 ermitteln
lz = Cells(Rows.Count, 1).End(xlUp).Row
zx = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row

Range("A1:A" & lz).Copy
Worksheets("Tabelle3").Select
Range("A" & zx + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False

'Duplikate in Tabelle3 entfernen
Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo

SpalteA_sortieren   'A sortieren

lz = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").Select

MsgBox zx - lz & "  Titel neu hinzugkommen"
End Sub



Sub SpalteA_sortieren()
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Columns(1)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub



  

Betrifft: AW: einfachste Möglichkeit von: Piet
Geschrieben am: 24.09.2019 23:43:39

Nachtrag

gestartet werden muss nur das erste Makro. Und achte bitte mal in Tabelle3 ob da die Überschrift nach unten sortiert wird? Dann muss ich das noch aendern.

mfg Piet


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 08:53:06

Hallo Piet,

erstmal danke für deine Mühe.
Prinzipiell funktioniert es, nur leider hat sich beim Testen mit einem anderen Text eine Schwachstelle aufgezeigt:

Dieser Text beinhaltete die Zeile

21-year-old media darling is known for her portrayal as Emma Ross on the fan favorite Disney's Jessie and Bunk'd, and made a name for herself on the network's long-running series.

Die Zeile wurde mit in Tabelle3 übernommen obwohl sie nicht dem eigentlichen vorgegebenen System mit den Ordnungszahlen entspricht.

Schaust du da bitte nochmal nach?

Ach so und noch was zweites, war zwar eine nette Idee mit einem Button, ich habe nur leider keine Ahnung wie man so einen erstellt.

Gruß
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Piet
Geschrieben am: 25.09.2019 17:59:56

Nachtrag - Button Frage
Schau bitte mal in Youtube rein, da gibt es gute Anleitungen wie du das machen kannst. Auch andere gute Tipps zu Excel!


  

Betrifft: AW: einfachste Möglichkeit von: Piet
Geschrieben am: 25.09.2019 17:55:55

Hallo Christian

der Fehler in meinem Makro ist sehr einfach zu korrigieren, das kannst du selbst machen! Unten der Code Teil dazu.
Beim Befehl Instr() muss ein Punkt rein, anstatt " "! Das ist alles! - AC.Value = Trim(Mid(AC, InStr(AC, ".", 100))

mfg Piet

  For Each AC In Range("A1:A" & lz)
     If IsNumeric(Left(AC, 1)) Then
        AC.Value = Trim(Mid(AC, InStr(AC, " "), 100))
     Else   'restliche Zeilen löschen
        Cells(AC.Row, 1).Resize(lz, 1).Clear
     End If
  Next AC



  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 19:39:33

Hallo Piet,

jetzt werden nur die Zahlen entfernt, die Punkte bleiben erhalten.

Gruß
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 19:40:46

Hallo Piet,

jetzt werden nur die Zahlen entfernt, die Punkte bleiben erhalten.

Gruß
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Werner
Geschrieben am: 25.09.2019 00:48:57

Hallo Christian,

hier mal die "Aufbereitung" der Daten.

Die brauchst du dann nur noch ans Ende vun Tabelle 3 zu kopieren und dann Duplikate entfernen auf die Spalte anzuwenden.

Public Sub aaa()
Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    .Rows(1).Insert
    .Range("A1") = "Name"
    .Range("B1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
    .FormulaLocal = "=WENN(ISTZAHL(LINKS(A1;1)*1);ZEILE();0)"
    .Range("B1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value = _
    .Range("B1:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    .Columns("A:B").RemoveDuplicates Columns:=2, Header:=xlNo
    .Columns("B").ClearContents
    .Columns("A").Replace What:="*. ", Replacement:="", LookAt:=xlPart
    .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Sort _
    Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes, orderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
    .Rows(1).Delete
End With
    
End Sub
Gruß Werner


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 08:57:51

Hallo Werner,

prinzipiell funktioniert auch dieses Makro,

nur ich bin mit einem anderen Text genauso wie bei Petes Makro auf das Problem mit der Zeile

21-year-old media darling is known for her portrayal as Emma Ross on the fan favorite Disney's Jessie and Bunk'd, and made a name for herself on the network's long-running series.

gestoßen. Die eigentlich hätte gelöscht werden sollen, da sie nicht dem genannten System mit den Ordnungszahlen entspricht.

Gruß und schonmal Danke
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Daniel
Geschrieben am: 25.09.2019 08:00:18

Hi
1. füge diese Formel in Spalte B ein und ziehe sie nach unten

=WENNFEHLER(WENN(FINDEN(".";A1)<=4;GLÄTTEN(TEIL(A1;FINDEN(".";A1)+1;999));"");"")

2. kopiere die Spalte B als Wert nach Tabelle3
3. sortiere die Spalte
4. entferne die Duplikate
5. lösche das letzte Falsch

Wenn du dir die Formel irgendwo "griffbereit" ablegst, sollte das so etwas einfacher sein.

Gruß Daniel


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 08:45:27

Hallo Daniel,

auch wenn ich das Prinzip hinter deiner Formel verstehe, gibt sie bei mir anderes aus, als anscheinend von dir beabsichtigt.

2 Dinge: Wenn ich sie in meine Beispieldatei einfüge, gibt sie in keiner der Zeilen FALSCH aus, ich kann also nicht nachvollziehen, wo ein FALSCH zustande kommen soll, dass ich dann löschen soll.

Das andere, in B35, B309 und B347 gibt die Formel Punkte aus, das ar natürlich so nicht von mir gedacht.

Gruß und danke schonmal
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Daniel
Geschrieben am: 25.09.2019 09:41:31

Hi
sorry, hatte das nachträglich noch mal geändert und statt FALSCH den Leerstring "" als Ausgabe für nicht benötigte Zeilen verwendet.
die die Zeilen, die du nicht benötigst, sollten leer bleiben.
ansonsten ersetze halt die "" durch FALSCH.

die drei aufeinander folgenden Punkte kannst du noch mit einer vorgeschalteten WENN-Abfrage ausschalten:
=Wenn(A1="...";Falsch;hier die weitere Formel)
Gruß Daniel


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 19:46:53

Hallo Daniel,

habe es noch etwas abgeändert in 

=WENN(A1="…";"";WENNFEHLER(WENN(FINDEN(".";A1)<=4;GLÄTTEN(TEIL(A1;FINDEN(".";A1)+1;999));"");""))
Aber so scheint es zu funktionieren.
Danke
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Werner
Geschrieben am: 25.09.2019 14:07:40

Hallo Christian,

hier mit der Formel von Daniel (ohne die Erweiterung vom letzten Beitrag Daniels) weil in deinen Rohdaten Versionen vorkommen z.B. In... die von der Formel nicht erfasst werden.

Die Punkte eliminiere ich mit Replace.

Public Sub aaa()
Dim wsQ As Worksheet, wsZ As Worksheet
Dim loLetzte As Long, loLetzteNeu As Long

Set wsQ = ThisWorkbook.Worksheets("Tabelle1")
Set wsZ = ThisWorkbook.Worksheets("Tabelle3")

Application.ScreenUpdating = False

wsQ.Range("B1:B" & wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row).FormulaLocal = _
"=WENNFEHLER(WENN(FINDEN(""."";A1)<=4;GLÄTTEN(TEIL(A1;FINDEN(""."";A1)+1;999));"""");"""")"
wsQ.Range("B1:B" & wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row).Value = _
wsQ.Range("B1:B" & wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row).Value
wsQ.Range("B1:B" & wsQ.Cells(wsQ.Rows.Count, "B").End(xlUp).Row).Replace ".", ""
loLetzte = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
wsQ.Range("B1:B" & wsQ.Cells(wsQ.Rows.Count, "B").End(xlUp).Row).Copy _
wsZ.Range("A" & wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Offset(1).Row)
wsQ.Columns("B").ClearContents
wsZ.Range("A1:A" & wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row).Sort _
Key1:=wsZ.Range("A1"), Order1:=xlAscending, Header:=xlNo, orderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
wsZ.Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo
loLetzteNeu = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
If loLetzteNeu - loLetzte = 0 Then
    MsgBox "Es gibt keine neuen Datensätze."
Else
    MsgBox "Es wurden " & loLetzteNeu - loLetzte & " Datensätze hinzugefügt."
End If

Set wsQ = Nothing: Set wsZ = Nothing
End Sub
Gruß Werner


  

Betrifft: AW: einfachste Möglichkeit von: Christian
Geschrieben am: 25.09.2019 19:51:12

Hallo Werner,

soweit ich es überblicken kann, sieht auch das jetzt super aus.

Aber eine kleine Frage hätte ich noch, ich bin grad am überlegen, ob es für mich nicht sinnvoller ist, die Tabelle3 unsortiert zu lassen.

Reicht es einfach den Teil

Key1:=wsZ.Range("A1"), Order1:=xlAscending, Header:=xlNo, orderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
zu löschen, wenn ich nicht sortieren will oder muss ich da noch mehr machen?

Gruß
Christian


  

Betrifft: AW: einfachste Möglichkeit von: Piet
Geschrieben am: 26.09.2019 08:28:53

Hallo Christian

Sorry, dummer Flüchtigkeitsfehler. Jetzt sollte der Code auch wesentlich schneller laufen wie vorher.
AC.Value = Trim(Mid(AC, InStr(AC, ".") + 1, 100)) - Hatte die +1 im Code vergessen!!

mfg Piet

Sub String_aufbereiten()
Dim AC As Variant, zx, lz As Integer
Worksheets("Tabelle1").Select
SpalteA_sortieren   'A sortieren

'Punkte Vorspann abschneiden
For lz = 1 To 100
   If Len(Cells(1, 1)) < 10 Then Rows(1).Delete
Next lz

Application.ScreenUpdating = False
'LastZell in Spalte A ermitteln
lz = Cells(Rows.Count, 1).End(xlUp).Row
'Alle Nummern 1.-100. abschneiden
For Each AC In Range("A1:A" & lz)
   If IsNumeric(Left(AC, 1)) Then
      AC.Value = Trim(Mid(AC, InStr(AC, ".") + 1, 100))
   Else   'restliche Zeilen löschen
      Cells(AC.Row, 1).Resize(lz, 1).Clear
      Exit For
   End If
Next AC

'LastZell in Spalte A + Tabelle 3 ermitteln
lz = Cells(Rows.Count, 1).End(xlUp).Row
zx = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = True

Range("A1:A" & lz).Copy
Worksheets("Tabelle3").Select
Range("A" & zx + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False

'Duplikate in Tabelle3 entfernen
Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo

SpalteA_sortieren   'A sortieren

lz = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").Select

MsgBox zx - lz & "  Titel neu hinzugkommen"
End Sub



Beiträge aus dem Excel-Forum zum Thema "einfachste Möglichkeit"

Eingabemöglichkeit auf 255 Zeichen je Zelle begrenzen
Auflistung aller Kombinationsmöglichkeiten
Beschränkung der Eingabemöglichkeit auf 32 Zellen