VBA: nächste freie Bildnummer

Hallo zusammen,
für eine Fotoaktion habe ich eine Exceltabelle mit Maske entworfen, in der Namen und Bildnummer aufgenommen werden sollen.
Die Tabelle ist soweit fertig, ich benötige jedoch noch eine Funktion zur Ermittlung der nächsten freien Bildnummer aus der Spalte B "Fotonummer". In dieser Spalte sind alle bisher vergebenen Nummern eintragen, jedoch können in einer Zelle mehrere Bildnummern (getrennt durch Komma; Bsp. "00001, 00002, 00003") stehen.
Die nächste freie Bildnummer soll dann per Button in einer Maske einfügbar sein.
Das Einfügen ist auch kein Problem; das einzige war mir Schwierigkeiten bereitet, ist die Ermittlung der höchsten Bildnummer aus dem Bereich der Spalte B.
Könnt ihr mir da helfen?
Gruß Andy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andy,
eine Möglichkeit.

' **********************************************************************
' Modul: Modul4  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub test()
MsgBox nextNumber(ActiveSheet.UsedRange.Columns(2))
End Sub


Private Function nextNumber(Target As Range) As Long
Dim rng As Range
Dim lngTmp() As Long, lngI As Long, lngN As Long
Dim vntTmp As Variant

For Each rng In Target.Cells
  If InStr(1, rng.Text, ",") > 0 Then
    vntTmp = Split(rng.Text, ",")
    For lngN = 0 To UBound(vntTmp)
      If IsNumeric(vntTmp(lngN)) Then
        Redim Preserve lngTmp(lngI)
        lngTmp(lngI) = Clng(vntTmp(lngN))
        lngI = lngI + 1
      End If
    Next
  Else
    If IsNumeric(rng.Text) Then
      Redim Preserve lngTmp(lngI)
      lngTmp(lngI) = Clng(rng.Text)
      lngI = lngI + 1
    End If
  End If
Next

If lngI > 0 Then nextNumber = Application.Max(lngTmp) + 1

End Function

Gruß Sepp

Private Sub CommandButton7_Click() Dim vntNumbers As Variant, lngN() As Long, lngI As Long If TextBox_Bildnummer = "" Then 'keine Nummer in der Textbox vorhanden TextBox_Bildnummer = nextNumberCells(ActiveSheet.UsedRange.Columns(2)) Else 'Nummern in der Textbox vorhanden '################# hier muss die Textbox berücksichtig werden vntNumbers = Split(TextBox_Bildnummer, ",") For lngI = 0 To UBound(vntNumbers) Redim Preserve lngN(lngI) lngN(lngI) = Clng(vntNumbers(lngI)) Next TextBox_Bildnummer = TextBox_Bildnummer & ", " & Application.Max(lngN) + 1 End If End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA: nächste freie Bildnummer

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

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread