Live-Forum - Die aktuellen Beiträge
Datum
Titel
01.10.2025 13:48:12
Outlook-Fenster in Vordergrund bringen
01.10.2025 13:28:07
.csv-Datei importieren / Daten abrufen
01.10.2025 13:23:46
Gesamtdiagramm - tricky
30.09.2025 21:34:46
VBA - Sharepoint den Pfad der lokalen Synchronisation ermitt
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1992to1996
1992to1996
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA erweitern bzw verbessern

Forumthread: VBA erweitern bzw verbessern

VBA erweitern bzw verbessern
30.09.2024 17:09:02
Simon
Hallo....

das ist meine aktuelle VBA...

Sub AusZwischenablage_zwischen_Klammern3()

Dim DaOb As DataObject
Dim txt As String
Dim Pos1 As Long
Dim Pos2 As Long

'-----------------------------------------------------
' Vor erstellen des Codes
' aktiviere unter EXTRAS - VERWEISE den Verweis:
' Microsoft Forms 2.0 Object Library
'-----------------------------------------------------

'text aus zwischenablage holen
Set DaOb = New DataObject
DaOb.GetFromClipboard
txt = DaOb.GetText

'text zwischen eckigen Klammern ermitteln
Pos1 = InStr(txt, "[") + 10
Pos2 = InStr(txt, "]")
oder
Pos1 = Instr(txt, "Incoming")
Pos1 = Instr(Pos1, txt, "[")
Pos2 = Instr(Pos1, txt, "]")

If Pos1 > 0 And Pos2 > Pos1 Then
txt = Left(txt, Pos2 - 1)
txt = Mid(txt, Pos1 + 1)

'Text in feste Zelle einfügen
ActiveSheet.Range("B3") = Replace(txt, vbCrLf, "")
Else
Beep
End If


läuft soweit ganz gut...
meine Frage dazu, es sind Zahlen die ins Feld B3 geschrieben werden..
ist es möglich wenn die VBA eine bestimmte Zahl erkennt diese auszulassen und mit der nächsten Zahl weiter zu machen...
dies ist die Zahlenreihe
1, 2, 4, 9, 5, 6, 7, 49, 3, 14
er soll alle Zahlen schreiben außer die 49 wenn diese mit dabei ist.

Danke für Eure Hilfe..
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA erweitern bzw verbessern
30.09.2024 17:21:44
BoskoBiati2
Hi, 

ActiveSheet.Range("B3") = Replace(ActiveSheet.Range("B3"),"49, ","")


nach end if


Gruß

Edgar
AW: VBA erweitern bzw verbessern
30.09.2024 17:25:32
Piet
Hallo Simon

die Antwort hast du dir schon selbst gegeben, siehst es nur nicht. Setze hinter das 1. Replace noch eins!
ActiveSheet.Range("B3") = Replace(Range("B3"), " 49,", "")

mfg Piet
Anzeige
AW: VBA erweitern bzw verbessern
30.09.2024 19:20:42
Yal
Moin,

ich würde die Bereinigung der "49" umgedreht machen, also ", 49" anstatt "49, ". Dann passt es auch, wenn 49 an letzter Stelle ist.

Wenn die Leerzeichen dazwischen ungewiss sind, dann so 
'Text in feste Zelle einfügen

txt = Replace(txt, vbCrLf, "")

txt = Replace(txt, " ", "") 'Leerzeichen wegwerfen

txt = Replace(txt, ",49", ",") '49 bereinigen inkl. direkt bevorstehende Komma 

txt = Replace(txt, ",", ", ") 'Optional!

ActiveSheet.Range("B3") = txt


Wenn Du die letzten 4 Elemente direkt Suchen möchtest, dann so: 
Function Letzten(ByVal Text As String, Anzahl As Integer, Optional Trenner As String = ",")

Dim i As Integer

Dim Pos As Integer



    For i = 1 To Anzahl

        Pos = InStrRev(Text, Trenner, Pos - 1)

    Next

    Letzten = Mid(Text, Pos + 1)

End Function



Sub Test()

    Debug.Print Letzten("1,2,3,4,5,6,7,8", 4)

    Debug.Print Letzten("1,2,3,4,5,6,7,8", 3)

    Debug.Print Letzten("1,2,3,4,5", 4)

    Debug.Print Letzten("1,2,3,4,5", 3)

End Sub


VG
Yal
Anzeige
Du könntest es mal...
30.09.2024 23:09:15
Case
Moin, :-)

... so probieren: ;-) 

Option Explicit

Public Sub Main_1()

    Range("H3:K3").FormulaArray = "=INDEX(FILTERXML(""""&SUBSTITUTE(B3,"", "","""")&"""",""//s[.!=49]""),COUNT(FILTERXML(""""&SUBSTITUTE(B3,"", "","""")&"""",""//s[.!=49]""))-4+COLUMN(A1:D1))"

End Sub

Public Sub Main_2()

    With Range("H3:K3")

        .FormulaArray = "=INDEX(FILTERXML(""""&SUBSTITUTE(B3,"", "","""")&"""",""//s[.!=49]""),COUNT(FILTERXML(""""&SUBSTITUTE(B3,"", "","""")&"""",""//s[.!=49]""))-4+COLUMN(A1:D1))"

        .Value = .Value

    End With

End Sub


Beim ersten wird die Formel behalten, beim zweiten durch den Wert ersetzt. Klappt das, dann die Zeile(n) am Ende von deinem Makro anhängen. ;-)

Servus
Case
Anzeige
AW: VBA erweitern bzw verbessern
30.09.2024 20:55:25
Simon
@Yal

Danke für die Info.
ist eine sehr schöne Lösung.

Deine Zweite Lösung ist auch sehr schön gedacht..
wie du richtig sagst wie brauchen immer die letzten 4 Ziffern außer die 49
die Zahlen folge kann aber auch mal so aussehen..
1, 2, 4, 9, 5, 6, 7, 49, 3, 14, 11, 16, 13, 8, 12, 10, 17, 18, 15, 21, 19, 25, 20, 22, 23, 24, 26, 28, 31, 30, 27, 29, 33, 32, 34, 36, 35, 40, 37, 39, 41, 42, 38, 44, 43
im längsten Fall 62 Zahlen...
konnte man auch die letzten 4 jede in ein anderes Feld schreiben....
z.B.
H3=42
I3 = 38
J3 = 44
K3 = 43

also immer die letzen 4 außer wenn da die 49 mit dabei ist...

VG
Simon
Anzeige
AW: VBA erweitern bzw verbessern
30.09.2024 22:43:35
Uduuh
Hallo,
aufgesetzt auf deinen Ursprungscode: 
If Pos1 > 0 And Pos2 > Pos1 Then

  txt = Left(txt, Pos2 - 1)

  txt = Mid(txt, Pos1 + 1)

  txt = Replace(txt, vbCrLf, "")

  vntTmp = Split(txt, ",")

  For i = 0 To UBound(vntTmp)

    If CInt(vntTmp(i)) > 49 Then

      strTmp = strTmp & "," & vntTmp(i)

    End If

  Next i

  strTmp = Mid(strTmp, 2)

  vntTmp = Split(strTmp, ",")

  strTmp = ""

  For i = UBound(vntTmp) - 3 To UBound(vntTmp)

    strTmp = strTmp & "," & vntTmp(i)

  Next i

  Range("H3").Resize(, 4) = Split(strTmp, ",")

End If

Am Anfang des Codes natürlich noch 
Dim vntTmp

Dim strTmp As String

Dim i As Integer


Gruß aus'm Pott
Udo
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige