Nummernkreis Abfrage & Eintrag

Hallo und Mahlzeit zusammen,
ich habe ein neues Problem, bei dem ich eure Unterstützung benötige.
Ich erstelle mit einer Mappe ein Blatt, in das eine freie Nummer aus einem Nummernkreis eingetragen werden soll.
Die Nummern beziehe ich aus einer anderen Mappe.
Die freie Nummer soll durch die OptionButton eingegrenzt werden (Nummern im Test Mappe).
Als Bsp: In meinem Nummernkreis ist die 41009 frei (E10 nicht belegt), ich betätige den OptionButton Station, nun will ich die 41009 in der Textbox FreiNr rückgemeldet haben und dann soll bei betätigen des CommandButtons NrUebernehmen die Bezeichnung aus TextBox Bezeichnung in E10 geschrieben werden (und somit die Nr belegt werden).
Kann mich hier jemand unterstützen? Danke!
https://www.herber.de/bbs/user/144381.xlsm
https://www.herber.de/bbs/user/144380.xlsx
Gruß Lars

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Moin!
Hier mal dein Code zurück.
Die Variablen rng und Wb1sh1 würde ich globbal machen. Dann könnten auch die verschiendenen Button zugreifen. Zudem war bei der Prüfung, ob das WB offen ist ein not zu wenig. Was soll den mit den anderen OptionButton passieren? ICh würde vorschlagen, da nur eine Prozedur zu schreiben. Allerdings sind die Min und Max Werte im Blatt nur eine Zahl (Bei den anderen Werten). Wie soll da vorgegangn werden?


Option Explicit
Dim rng As Range
Dim wb1ws1 As Worksheet
Private Sub EigeneNr_Click()
Call NummernkreisEingeben1
Unload NummernkreisWaehlen
End Sub
Private Sub NrUebernehmen_Click()
'jetzt eintragen
If Trim(Me.Bezeichnung) = "" Then
MsgBox "Nix eingetragn!"
Exit Sub
End If
rng.Offset(, 4) = Me.Bezeichnung
Unload NummernkreisWaehlen
End Sub
Private Sub Schließen_Click()
Unload NummernkreisWaehlen
'Range("C1").AutoFilter
End Sub
Private Sub Station_Click()
Dim MyMax&, MyMin, MyBool As Boolean
Dim LoLetzte&
Dim wb1 As Workbook
Dim wb1pfad As String
Dim wb1name As String
Dim bwbopen As Boolean
Dim gefunden As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wb1pfad = "C:\Users\F5GDI4W\Documents\Wartungskarten\Vorlage\VBA\"           '  _
Datenarbeitsmappepfad
wb1name = "Nummernkreis.xlsx"                                                 '  _
Datenarbeitsmappename
If Not WorkbookIsOpen(wb1name) Then     'hgier fehlte ein not
Workbooks.Open (wb1pfad & wb1name)
Else
End If
Set wb1 = Workbooks(wb1name)
Set wb1ws1 = wb1.Worksheets("Nummernkreis")
With wb1ws1
LoLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
MyMax = 41299
MyMin = 41000
gefunden = False
For Each rng In wb1ws1.Range("A2:A" & LoLetzte) 'Bereich Anpassen oder Einlesen
If rng = MyMin Then
If rng.Offset(, 4) = "" Then
gefunden = True
Exit For
End If
End If
Next
If gefunden Then
FreieNR = rng
MsgBox FreieNR
Else
MsgBox "NIx gefunden!"
End If
End Sub
Private Sub UserForm_Click()
End Sub
Function WorkbookIsOpen(WBName As String) As Boolean
On Error Resume Next
WorkbookIsOpen = Not Workbooks(WBName) Is Nothing
End Function

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nummernkreis Abfrage & Eintrag

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread