Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Shermi vom 18.08.2021, 10:28 Options

Excel Makro: Datei speichern unter anderem Namen, falls Name in Ordner schon vorhanden ist

Ich habe in Excel ein Makro geschrieben, dass die Datei unter einem bestimmten Namen speichert, der sich aus verschiedenen Teilen zusammensetzt, die in der Tabelle gefunden werden (z.B. Angebot vom Datum für Kunde).
Nun kommt es vor, dass für einen Kunden mehrere Angebote am Tag erstellt werden müssen. Trotzdem soll aber automatisch gespeichert werden, ohne den Namen händisch ändern zu müssen. Schön wäre es, wenn man prüfen könnte, ob bereits eine Datei mit dem Namen existiert, und falls dem so ist, die aktuelle Datei unter einem anderen Namen (z.B. Angebot 2 vom Datum für Kunde). Falls "Angebot 2 vom Datum für Kunde" schon existiert, dann eben unter "Angebot 3 vom Datum für Kunde".

Ich bräuchte also irgendeine Art "Counter i", der mir die Nummer um eins erhöht, falls der Name existiert, beim ersten Angebot des Tages aber nicht die 1 anzeigt...

Geht sowas in irgendeiner Form?

Vielen Dank im Voraus

Antwort schreiben

Antwort 1 von nighty vom 18.08.2021, 13:40 Options

hi all ^^

ein beispiel :-)

gruss nighty

den pfad bei der ersten function angepassen

Sub Beispiel()
    'mustertabelle test
    'test wird test1,test2 usw. erzeugt
    If NeueZahl() = "" Then
        'speichern ohne nummer bei rueckgabewert  von 0
        'hier deine speicherfunction einsetzen
    Else
        'speichern mit nummer bei rueckgabewert  von groesser 0
        'hier deine speicherfunction einsetzen & NeueZahl()
    End If
End Sub

Function NeueZahl() As String
    Dim DateiPath As String
    Dim DateiEndung As String
    Dim DateiName As String
    Dim DateiNamen() As String
    Dim zaehler1 As Long
    Dim Dinfo As Long
    Dim AltZahl As Long
    DateiPath = "C:\temp1\"
    DateiEndung = "*.xls"
    zaehler1 = 1
    ReDim Preserve DateiNamen(zaehler1)
    DateiName = Dir(DateiPath & DateiEndung)
    Do While DateiName <> ""
        zaehler1 = zaehler1 + 1
        ReDim Preserve DateiNamen(zaehler1)
        DateiNamen(zaehler1) = DateiName
        DateiName = Dir
    Loop
    For Dinfo = 2 To UBound(DateiNamen())
        If Mid(DateiNamen(Dinfo), 1, Len(ActiveWorkbook.Name) - 4) = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) Then
            If Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1)) > AltZahl Then
                AltZahl = Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1))
                NeueZahl = AltZahl + 1
            End If
        End If
    Next Dinfo
End Function

Function SumZahlen(Zellen As Variant, zaehler1 As Integer) As String
    Dim Zelle As Range
    Dim zeich1 As Integer
    Dim schalter As Boolean
    Dim zaehler3 As Integer
    ReDim Zaehler2(Len([Zellen])) As String
    zaehler3 = 1
    Application.Volatile
    If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
    For zeich1 = 1 To Len([Zellen])
        If Mid([Zellen], zeich1, 1) Like "[0-9,.]" = True Then
            Zaehler2(zaehler3) = Zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
            schalter = True
        End If
        If schalter = True And Mid([Zellen], zeich1, 1) Like "[0-9,.]" = False Then
            zaehler3 = zaehler3 + 1
            schalter = False
        End If
    Next zeich1
    SumZahlen = Zaehler2(zaehler1)
End Function

Antwort 2 von nighty vom 18.08.2021, 13:44 Options

hi all ^^

das ginge bestimmt auch kuerzer :-)))

gruss nighty

Antwort 3 von nighty vom 19.08.2021, 10:51 Options

hi all ^^

korrigiert und vielleicht mit besserem beispiel

gruss nighty

sollte das datum vorangestellt sein,dann die kommentare der naechsten function beachten

Sub Beispiel()
    If NeueZahl() = 0 Then
        ActiveWorkbook.SaveCopyAs Filename:="C:\temp1\" & ActiveWorkbook.Name
    Else
        ActiveWorkbook.SaveCopyAs Filename:="C:\temp1\" & Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) & NeueZahl() & ".xls"
    End If
End Sub

Function NeueZahl() As Integer
    Dim DateiPath As String
    Dim DateiEndung As String
    Dim DateiName As String
    Dim DateiNamen() As String
    Dim zaehler1 As Long
    Dim Dinfo As Long
    Dim AltZahl As Integer
    DateiPath = "C:\temp1\"
    DateiEndung = "*.xls"
    zaehler1 = 1
    ReDim Preserve DateiNamen(zaehler1)
    DateiName = Dir(DateiPath & DateiEndung)
    Do While DateiName <> ""
        zaehler1 = zaehler1 + 1
        ReDim Preserve DateiNamen(zaehler1)
        DateiNamen(zaehler1) = DateiName
        DateiName = Dir
    Loop
    For Dinfo = 2 To UBound(DateiNamen())
        If Mid(DateiNamen(Dinfo), 1, Len(ActiveWorkbook.Name) - 4) = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) Then
            'waere das datum vor der zahlengenerierung,dann die zweite 1 in der naechsten zeile durch eine 2 ersetzen
            If Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1)) > AltZahl Then
                'waere das datum vor der zahlengenerierung,dann die zweite 1 in der naechsten zeile durch eine 2 ersetzen
                AltZahl = Val(SumZahlen(Mid(DateiNamen(Dinfo), 1, Len(DateiNamen(Dinfo)) - 4), 1))
            End If
            NeueZahl = AltZahl + 1
        End If
    Next Dinfo
End Function

Function SumZahlen(Zellen As Variant, zaehler1 As Integer) As String
    Dim Zelle As Range
    Dim zeich1 As Integer
    Dim schalter As Boolean
    Dim zaehler3 As Integer
    ReDim Zaehler2(Len([Zellen])) As String
    zaehler3 = 1
    Application.Volatile
    If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
    For zeich1 = 1 To Len([Zellen])
        If Mid([Zellen], zeich1, 1) Like "[0-9,.]" = True Then
            Zaehler2(zaehler3) = Zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
            schalter = True
        End If
        If schalter = True And Mid([Zellen], zeich1, 1) Like "[0-9,.]" = False Then
            zaehler3 = zaehler3 + 1
            schalter = False
        End If
    Next zeich1
    SumZahlen = Zaehler2(zaehler1)
End Function

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken