Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1464to1468
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

VBA Text auswerten und in Schleifen verarbeiten

VBA Text auswerten und in Schleifen verarbeiten
31.12.2015 10:42:02
Stefan Doliwa

Grüß Euch zusammen,
ich programmiere gerade die monatliche Steuererklärung und stehe nun vor einem Problem, welches ich bisher nicht im Internet gefunden habe.
In der Spalte I steht ein Text der über eine Schleife ausgewertet werden muß. Ich stelle mal die zwei Varianten dar, und hoffe jemand weiß, wie das geht.
Text in einer Zelle der Spalte I:
Emons blablabla, 240563355 End-to-End-Ref.: blabala Überweisung
Steht nun der Name "Emons" in einer Zelle der Spalte I so soll in der Spalte E der Wert 0,19 stehen. Dann soll das Programm über den Text "240" die Rechnungsnummer 240563355 erkennen und die Datei 240563355.pdf im Verzeichnis E:/Zahlungen als Hperlink in der Spalte J setzen.
Die andere Variante betrifft meine Rechnungen. Diese sollen über den Wert "2015-" oder "2016-" erkannt werden. Nach der Kennung folgt eine 3stellige, bald 4stellige Zahl, sagen wir jetzt mal 500. Dann soll über Makro die Datei E:Rechnungen/Formularrechnung.xlsm der Zellenwert F45 in die Spalte E übertragen werden und die Datei Formularrechnung500.xlsm wieder geschlossen werden. In der Spalte J soll nun der Hpyerlink E:/Rechnung/Rechnung500.pdf gesetzt werden.
Wer weiß, wie man diese zwei Schleifen programmieren muß. Dies übersteigt meine VBA Kenntnisse. Danke!
Stefn

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Text auswerten und in Schleifen verarbeiten
31.12.2015 10:59:39
ransi
Hallo Stefn,
Gib uns doch mal 2 Beispieldateien.
Irgendwelche aussagefähigen Dummydatensätze.
Dann weiß man was wo steht, was wo hin soll und kann vernüpnftig testen.
ransi

Teil 1)
31.12.2015 13:09:38
ransi
Hallo Stefan,
Teste mal:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const Pfad As String = "E:\Zahlungen\"

Sub machs()
    Dim Bereich As Range, Zelle As Range
    Dim Regex As Object, objM As Object
    Set Regex = CreateObject("Vbscript.Regexp")
    With Sheets("2016")
        Set Bereich = Intersect(.Range("I1").CurrentRegion, .Range("I:I")) 'in einer Zelle der Spalte I
        With Regex
            .Pattern = "(Emons).+(240\d+)" 'Dann soll das Programm über den Text "240" die Rechnungsnummer 240563355 erkennen
            .Global = False
            For Each Zelle In Bereich
                If .test(Zelle.Text) = True Then
                    Set objM = .Execute(Zelle.Text)
                    ' MsgBox objM(0).Value
                    SchreibMwSt Zelle.Offset(0, -3)
                    schreib_Hyperlink Zelle.Offset(0, 1), Pfad & objM(0).submatches(1) & ".pdf"
                End If
            Next
        End With
    End With
End Sub


Sub SchreibMwSt(Ziel As Range)
    Ziel.Value = 0.19 'so soll in der Spalte E der Wert 0,19 stehen.
End Sub

Sub schreib_Hyperlink(Ziel As Range, Linkadresse As String)
    Sheets("2016").Hyperlinks.Add Anchor:=Ziel, Address:=Linkadresse 'die Datei 240563355.pdf im Verzeichnis E:/Zahlungen als Hperlink in der Spalte J setzen.
End Sub


ransi

Anzeige
AW: Teil 1)
31.12.2015 14:36:24
Stefan Doliwa
Grüß Dich Ransi,
ich werde es testen, wenn ich die scheinbar einfache Hochzählerei gelöst habe. Bitte melde Dich bei mir, ich möchte Dir eine Spende zukommen lassen, denn so kann ich es nicht stehen lassen. 0 neun 1 acht 7/907227.
Stefan

AW: Teil 1)
31.12.2015 15:25:57
Stefan Doliwa
WOW Ransi, es funktioniert erstklassig! Das schlimme daran ist leider nur, daß ich große Teile Deiner Programmierung nicht verstehe. Ich kann zwar jetzt diese Prozedur auf die anderen Dinge anbändern, aber verstanden hätte ich es gerne. Aber wahrscheinlich ist zum Verständnis auch mein VBA-Wissensstand zu klein. Jedenfalls 1000Dank und bitte melden, es muß ein Ausgleich geschaffen werden!

Anzeige
Teil 2)
01.01.2016 13:40:25
ransi
Hallo Stefan,
...es muß ein Ausgleich geschaffen werden!
Schließ mich in dein Nachtgebet mit ein und Alles ist gut...;-)
Teste mal dies:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const Pfad_Zahlungen As String = "E:\Zahlungen\"
Const Pfad_Rechnungen As String = "E:\Rechnungen\"

Sub Aufruf()
    Call Emons
    Call Rechnungen
End Sub


Sub Emons()
    Dim Bereich As Range, Zelle As Range
    Dim Regex As Object, objM As Object
    Set Regex = CreateObject("Vbscript.Regexp")
    With Sheets("2016")
        Set Bereich = Intersect(.Range("I1").CurrentRegion, .Range("I:I")) 'in einer Zelle der Spalte I
        With Regex
            .Pattern = "(Emons).+(240\d+)" 'Dann soll das Programm über den Text "240" die Rechnungsnummer 240563355 erkennen
            .Global = False
            For Each Zelle In Bereich
                If .Test(Zelle.Text) = True Then
                    Set objM = .Execute(Zelle.Text)
                    ' MsgBox objM(0).Value
                    SchreibMwSt Zelle.Offset(0, -3)
                    schreib_Hyperlink Zelle.Offset(0, 1), Pfad_Zahlungen & objM(0).submatches(1) & ".pdf"
                End If
            Next
        End With
    End With
End Sub



Sub Rechnungen()
    Dim Bereich As Range, Zelle As Range
    Dim Regex As Object, objM As Object
    Set Regex = CreateObject("Vbscript.Regexp")
    With Sheets("2016")
        Set Bereich = Intersect(.Range("I1").CurrentRegion, .Range("I:I")) 'in einer Zelle der Spalte I
        With Regex
            .Pattern = "(2015|2016)\-(\d{3,4})(?=\D)" '"2015-" oder "2016-" erkannt werden. Nach der Kennung folgt eine 3stellige, bald 4stellige Zahl,
            .Global = False
            For Each Zelle In Bereich
                If .Test(Zelle.Text) = True Then
                    Set objM = .Execute(Zelle.Text)
                    MsgBox "Treffer " & objM(0).submatches(1)
                    schreib_Hyperlink Zelle.Offset(0, 1), Pfad_Rechnungen & objM(0).submatches(1) & ".pdf"
                    schreib_F45 Zelle.Offset(0, -4), "='" & Pfad_Rechnungen & "[Formularrechnung" & objM(0).submatches(1) & ".xlsm]Tabelle1'!$F$45"
                End If
            Next
        End With
    End With
End Sub


Sub SchreibMwSt(Ziel As Range)
    Ziel.Value = 0.19 'so soll in der Spalte E der Wert 0,19 stehen.
End Sub


Sub schreib_Hyperlink(Ziel As Range, Linkadresse As String)
    Sheets("2016").Hyperlinks.Add Anchor:=Ziel, Address:=Linkadresse 'die Datei 240563355.pdf im Verzeichnis E:/Zahlungen als Hperlink in der Spalte J setzen.
End Sub


Sub schreib_F45(Ziel As Range, Formel As String)
    With Ziel
        .FormulaLocal = Formel
        .Value = .Value
    End With
End Sub


ICh hoffe ich habs richtig verstanden.
In deiner Beschreibing hast du meherere Pfade unter E: und mehrere Formularrechnung* erwähnt.
ransi

Anzeige
AW: Teil 2)
01.01.2016 16:10:43
Stefan Doliwa
Guten Tag Ransi,
Deine neue Programmierung funktioniert fast. Fast nur deshalb, weil die Formularrechnungen aus dem Verzeichnis geholt werden wollen, in dem die Datei steht und nicht, wie der Pfad_Rechnungen angegeben ist.
Pfad der Datei: E:\daten\sdoliwa\Eigene Dokumente\2012\Firma\Pluenderung
Pfad Rechnungen: E:\daten\sdoliwa\Eigene Dokumente\2012\Firma\Rechnungen
Da ich unter Const das Verzeichnis geändert habe, dachte ich, daß wie gestern das Programm läuft. Aber er sucht immer im falschen Verzeichnis, also in Pluenderung statt in Rechnungen. Verstehst Du warum?
Dann wollte ich Dein gestrige Programm umändern, um folgende Wörter aus dem Range("I:I") zu löschen:
Gutschrift
Überweisung
wiederholend
SEPA-BASISLASTSCHRIFT
Zinsen/Entgelte
Lastschrift
NOTPROVIDED Kundenreferenz: 20/+d
End-to-End-Referenz: NOTPROVIDED
Kundenreferenz: NSCT/+d
Leider geht der Befehl: Set objM = .Delete(Zelle.Text) nicht.
Und bitte melden, ich muß einen energetischen Ausgleich herstellen, denn ein Forum ist zur Selbsthilfe und nicht zur Programmierung da!

Anzeige

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige