[Excel] Autom. Nummerierung aus VBA Code entfernen

josef24

Erfahrenes Mitglied
Hallo und guten Abend. Ich habe eine EXCEL- Datei wo wenn ich einen neuen Datensatz einfüge automatisch auch eine fortlaufende neue LfdNr. in Spalte A eingefügt wird. Das führt zu Problemen wenn ich z. B. eine Zeile lösche oder einfüge, die dann alphabetisch sortiert an einen andere Zeile rutscht. Nun habe ich in der Tabelle4 eine Codezeile eingefügt die mir automatisch die lfdNr. hoch zählt. Somit ist die autom. Nummerierung bei der Datensatzeröffnung hinfällig. und stört. Wäre von den hierin versierten einer bereit mich da zu unterstützen. Ich hänge mal die Datei an, in der Hoffnung das ich bei jemand Interesse für das Problem geweckt habe. Danke schon jetzt und Gruß Josef
 
Das ist ein halbes Program. Es hat keine Anleitung. Der Code ist unformatiert, unlesbar und hat keine Kommentare die weiterhelfen.
Wie soll ich jetzt wissen, wie deine neue Zeile eingefügt wird und welches der relevante Code ist? Alles durchprobieren - nein. Dein ganzer Code lesen und dan raten - nein. Dir sagen, dass du wie immer zu wenig Infos geliefert hast - ja.
Also, wo in deinem Program ist diese ominöse Datensatzeröffnung Im Excel drin?

Nachtrag. Eine "Tabelle4" exisitiert auch nicht.
 
Sorry, ich versuche es hier mal besser zu machen, und füge die erforderlichen Codes mal hier an.
Die Datei kann ich wenn gewünscht noch nachliefern.
Also die PosNr in Spalte "A" will ich über eine Formel einfügen, was bedeutet das die PosNr als Datenfeld erhalten bleiben muss, aber im VBA Code ansonsten keine Berücksichtigung haben soll.

Die Datensatzeröffnung für neuen Datensatz:
Visual Basic:
' * Neuer Eintag öffnen
Sub cmdNew_Click() ' CommandButton1
Dim lZeile As Long
Dim i As Long
Dim eintrag As Long
Dim ufelemente
Dim indextb
Dim rngRow As Range
Dim antwort

ufelemente = Array("txtPosNr", "txtnummer", "txtAnrede", "txtNachname", "txtVorname", "txtStrasse", "txtWohnort", "txtTelefon", "txtGeburtstag", "txtEintritt", "txtAustritt", "txtgenBis", "txtgruppe", "txtkrankenkasse", "txtKrKNr", "TxTBemerkung", "TxTZahlung")

    indextb = Array(1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 12, 13, 14, 19, 20, 21, 27)
        lZeile = wsat.Cells(Rows.Count, 1).End(xlUp).Row + 1 'erste freie zeile
    eintrag = 0
If seekArb(txtPosNr, rngRow) Then
Else
Exit Sub
End If
'prüfen ob sich was geändert hat

For i = 0 To UBound(ufelemente)
    If Trim(Me.Controls(ufelemente(i))) <> Trim(rngRow.Cells(, indextb(i)).Value) Then
        mvntWert = Trim(rngRow.Cells(, indextb(i)).Value)
        
            eintrag = eintrag + 1

        End If
    Next i
    
If eintrag > 0 Then cmdSave_Click
        antwort = MsgBox("Wollen Sie einen neuen Datensatz anlegen?", 4, "Neuer Datensatz")
            If antwort = 6 Then
            
        lstData.ListIndex = lstData.ListCount - 1
    'Prüfung ob schon ausgefüllt
    eintrag = 0
    
    For i = 2 To UBound(ufelemente)
    
        If Trim(Me.Controls(ufelemente(i))) <> "" Then eintrag = eintrag + 1

    Next i      'es steht nur der Anfang drin, also nichts neues
    
    If txtPosNr = lZeile - 1 And txtnummer = "NeuMtgld" And eintrag = 0 Then
        MsgBox "Es liegt noch ein unbearbeiter neuer Datensatz vor!" & vbNewLine & "Es wird keine neuer Satz erstellt!", , "Abbruch Datensatzerstellung"
        Exit Sub
        
    End If
    
    neusatz = True
        wsat.Cells(lZeile, 1) = CStr(lZeile)
        wsat.Cells(lZeile, 2) = CStr("NeuMtgld")
        wsat.Cells(lZeile, 1) = WorksheetFunction.Max(wsat.Columns(1)) '  - 1  'ermittelt die höchste PosNr und erhöht um 1 damit keine Dopplung vorkommt.
            
            lstData.AddItem
            lstData.List(lstData.ListCount - 1, 1) = CStr("NR" & lZeile)
            lstData.ListIndex = lstData.ListCount - 1
        neusatz = False
End If
End Sub

Und speichern erfolgt hiermit:

Visual Basic:
Private Sub cmdSave_Click() ' Daten übertragen , Datei – Speichern [aktive Arbeitsmappe]
Dim lZeile As Long
Dim rngRow As Range
'         dim Cdate as Range

If lstData.ListIndex = -1 Then Exit Sub
If Trim(CStr(txtPosNr.Text)) = "" Then

MsgBox "Sie müssen mindestens eine Nummer eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If

ausuf = True
'Zeile suchen und auslesen

 If seekArb(txtPosNr, rngRow) Then 'Werte übernehmen

 Worksheets("ArbTab").Unprotect  ' HIERMIT WIRD DIE TABELLE "ARBTAB" FÜR DEN ZUGRIFF GEÖFFNET

If rngRow.Cells(, colAtPosNr).Value <> CLng(Trim(CStr(txtPosNr.Text))) Then mvntWert = rngRow.Cells(, colAtPosNr).Value: rngRow.Cells(, colAtPosNr).Value = Trim(CStr(txtPosNr.Text))
If rngRow.Cells(, colAtNummer).Value <> txtnummer.Text Then mvntWert = rngRow.Cells(, colAtNummer).Value: rngRow.Cells(, colAtNummer).Value = txtnummer.Text
If rngRow.Cells(, colAtAnrede).Value <> ComboBox1.Text Then mvntWert = rngRow.Cells(, colAtAnrede).Value: rngRow.Cells(, colAtAnrede).Value = ComboBox1.Text
If rngRow.Cells(, colAtNachname).Value <> txtNachname.Text Then mvntWert = rngRow.Cells(, colAtNachname).Value: rngRow.Cells(, colAtNachname).Value = txtNachname.Text
If rngRow.Cells(, colAtVorname).Value <> txtVorname.Text Then mvntWert = rngRow.Cells(, colAtVorname).Value: rngRow.Cells(, colAtVorname).Value = txtVorname.Text
If rngRow.Cells(, colAtStrasse).Value <> txtStrasse.Text Then mvntWert = rngRow.Cells(, colAtStrasse).Value: rngRow.Cells(, colAtStrasse).Value = txtStrasse.Text
If rngRow.Cells(, colAtWohnort).Value <> txtWohnort.Text Then mvntWert = rngRow.Cells(, colAtWohnort): rngRow.Cells(, colAtWohnort).Value = txtWohnort.Text
If rngRow.Cells(, colAtTelefon).Value <> txtTelefon.Text Then mvntWert = rngRow.Cells(, colAtTelefon).Value: rngRow.Cells(, colAtTelefon).Value = txtTelefon.Text
' Beginnt hier DATUMSFELD LÖSCHEN WIE AUCH EINGEBEN MÖGLICH
If txtGeburtstag.Text = "" Then
   rngRow.Cells(, colAtGeburtstag).Value = ""
        ElseIf IsDate(txtGeburtstag.Text) Then
            If rngRow.Cells(, colAtGeburtstag).Value <> CDate(txtGeburtstag.Text) Then mvntWert = rngRow.Cells(, colAtGeburtstag).Value: rngRow.Cells(, colAtGeburtstag).Value = CDate(txtGeburtstag.Text) 'Datumsfeld mit Format
End If
If txtEintritt.Text = "" Then
   rngRow.Cells(, colAteintritt).Value = ""
        ElseIf IsDate(txtEintritt.Text) Then
            If rngRow.Cells(, colAteintritt).Value <> CDate(txtEintritt.Text) Then mvntWert = rngRow.Cells(, colAteintritt).Value: rngRow.Cells(, colAteintritt).Value = CDate(txtEintritt.Text) 'Datumsfeld mit Format
End If
If txtAustritt.Text = "" Then
   rngRow.Cells(, colAtAustritt).Value = ""
        ElseIf IsDate(txtAustritt.Text) Then
            If rngRow.Cells(, colAtAustritt).Value <> CDate(txtAustritt.Text) Then mvntWert = rngRow.Cells(, colAtAustritt).Value: rngRow.Cells(, colAtAustritt).Value = CDate(txtAustritt.Text) 'Datumsfeld mit Format
End If
If txtgenBis.Text = "" Then
   rngRow.Cells(, colAtgenbis).Value = ""
        ElseIf IsDate(txtgenBis.Text) Then
            If rngRow.Cells(, colAtgenbis).Value <> CDate(txtgenBis.Text) Then mvntWert = rngRow.Cells(, colAtgenbis).Value: rngRow.Cells(, colAtgenbis).Value = CDate(txtgenBis.Text) 'Datumsfeld mit Format
End If
' Endet hier
If rngRow.Cells(, colAtGruppe).Value <> txtgruppe.Text Then mvntWert = rngRow.Cells(, colAtGruppe).Value: rngRow.Cells(, colAtGruppe).Value = txtgruppe.Text
If rngRow.Cells(, colAtKrankenkasse).Value <> txtkrankenkasse.Text Then mvntWert = rngRow.Cells(, colAtKrankenkasse).Value: rngRow.Cells(, colAtKrankenkasse).Value = txtkrankenkasse.Text
If rngRow.Cells(, colAtKrKNr).Value <> txtKrKNr.Text Then mvntWert = rngRow.Cells(, colAtKrKNr).Value: rngRow.Cells(, colAtKrKNr).Value = txtKrKNr.Text
If rngRow.Cells(, colAtBemerkung).Value <> TxTBemerkung.Text Then mvntWert = rngRow.Cells(, colAtBemerkung).Value: rngRow.Cells(, colAtBemerkung).Value = TxTBemerkung.Text
If rngRow.Cells(, colAtZahlung).Value <> TxTZahlung.Text Then mvntWert = rngRow.Cells(, colAtZahlung).Value: rngRow.Cells(, colAtZahlung).Value = TxTZahlung.Text

ausuf = False

'User Formular neu laden
lZeile = Me.lstData.ListIndex 'Listindex merken

Call UserForm_Initialize

Me.lstData.ListIndex = lZeile 'wiederherstellen


 Else
 MsgBox "Nummer " & txtPosNr.Text & " nicht gefunden", vbExclamation + vbOKOnly
End If

Call cmdNew_Click

End Sub
 
Verstehe ich die Frage richtig? Du willst wissen, wo in deinem Code eine automatische Nummer für die Spalte A vergeben wird um diesen Teil auszubauen?
 
Hallo, ich möchte die Nummerierung im VBA Code "ausschalten" weil ich es mit Formeln in der ArbTab- Tabelle verwirklichen will. Gruß Josef
 
OK, also genau das was ich meinte. Leider finde ich in dienem Code auf die schnelle nicht, wo die nummer vergeben wird.
Das müsste mMn diese Zeile sein, die du auskommentieren müsstest. Sei ist in der Methode cmdNew_Click(().
Visual Basic:
wsat.Cells(lZeile, 1) = WorksheetFunction.Max(wsat.Columns(1)) '  - 1  'ermittelt die höchste PosNr und erhöht um 1 damit keine Dopplung vorkommt.
 
Danke, hab das mal versucht, scheint es aber nicht gewesen zu sein. Bringe noch den 3ten Code, der die USERFORM zum eingeben der Daten öffnet. Hier ist die PosNr ja auch schon relevant.

Visual Basic:
Private Sub lstData_Click() ' Eingabe der Daten in USERFORM
Dim rngRow As Range
Dim id As String

'****  clearForm

If lstData.ListIndex >= 0 Then    'die Range wird hier gesetzt mit LIstindex

  Set rngRow = wsat.Rows(lstData.ListIndex + 2)
 
'*****     txtPosNr = id
    
'*****        txtPosNr = rngRow.Cells(, colAtPosNr).Value
        
            txtnummer = rngRow.Cells(, colAtNummer).Value
            
txtAnrede = rngRow.Cells(, colAtAnrede).Value

    If txtAnrede = "Herr" Then
    
  UserForm1.ComboBox1.ListIndex = 0   'Anrede Herr in Userform auswählen
 Else
  UserForm1.ComboBox1.ListIndex = 1   'Anrede Frau in Userform auswählen
 End If
 
txtNachname = rngRow.Cells(, colAtNachname).Value
txtVorname = rngRow.Cells(, colAtVorname).Value
txtStrasse = rngRow.Cells(, colAtStrasse).Value
txtWohnort = rngRow.Cells(, colAtWohnort).Value
txtTelefon = rngRow.Cells(, colAtTelefon).Value
txtGeburtstag = Format(rngRow.Cells(, colAtGeburtstag), "dd.mm.yyyy")
txtEintritt = Format(rngRow.Cells(, colAteintritt), "dd.mm.yyyy")
txtAustritt = Format(rngRow.Cells(, colAtAustritt), "dd.mm.20yy")
txtgenBis = Format(rngRow.Cells(, colAtgenbis), "dd.mm.20yy")
txtgruppe = rngRow.Cells(, colAtGruppe).Value
txtkrankenkasse = rngRow.Cells(, colAtKrankenkasse).Value
txtKrKNr = rngRow.Cells(, colAtKrKNr).Value
TxTBemerkung = rngRow.Cells(, colAtBemerkung).Value
TxTZahlung = rngRow.Cells(, colAtZahlung).Value

End If
End Sub
 
Sehe ich es richtig, du weisst selber nicht mehr was in deinem Code abgeht? Schreib beim Programmieren Kommentare, Strukturiere den Code.
Was gut ist, die Variablennamen sind relativ aussagekräftig. Auch die Spaltenindexe mit den colX-Namen sind sehr schön.

In lstData_Click() hast du die PosNr ja bereits ausgeschaltet.
 
Danke, aber bis jetzt ist nicht wirklich ein Erfolg bezüglich der PosNr. Es wird nur sinn machen wenn man die Datei in der Praxis mal prüft. Wenn man hierfür bereit wäre würde ich die Datei nochmal anhängen. Leider schaffe ich alleine nicht. Gruß Josef
 

Neue Beiträge

Zurück