Office: Schleife um 1.000.000 Textboxen auszulesen

Hallo zusammen,

gut der Titel war wohl etwas übertrieben aber ich würde gerne eine Schleife basteln die mir Viel Schreibarbeit abnehmen würde.

Und zwar geht es um folgendes, ich arbeite nach wie vor an meinem kleinen Rechnungsprogramm und jetzt geht es um den übertrag der Posten in meine kleine Datenbank. Die Daten sollen alle in eine Zeile geschrieben werden.

aussehen tut das ca. so:

Code:

'#Block1
txtBez1.Value = .Range("O" & m_lngZeile)
cbxEinheit1.Value = .Range("P" & m_lngZeile)
txtMenge1.Value = .Range("Q" & m_lngZeile)
txtP1.Value = .Range("R" & m_lngZeile)
''Block2
txtBez2.Value = .Range("S" & m_lngZeile)
cbxEinheit2.Value = .Range("T" & m_lngZeile)
txtMenge2.Value = .Range("U" & m_lngZeile)
txtP2.Value = .Range("V" & m_lngZeile)

Die Art und weise funktioniert einwandfrei nur finde ich sie wenig elegant und langsam erreicht mein Projekt eine für mich kritische Masse was die Länge der codes in der userform angeht. Somit würde ich gerne eine Schleife bauen. Ich weiß aber nicht recht wie ich das angehen soll. Schleifen finde ich immer etwas schwerer zu verstehen als andere vba "Probleme" in denen es nur um die syntax geht.

Im Internet habe ich eine code-sequence gefunden die ich für gar nicht so falsch halte. Aber ich kann irgendwie die "spaltenvariable" und die txt1-4 nicht definieren.

also hier mein Ansatz:

Code:

Private Sub CommandButton22_Click()
Dim K As Integer
Txt1 As Variant ' Eigentlich ein Text als "String" aber damit gehts auch nicht, Variant war mein letzter versuch
cbx1 As Variant ' Selbes problem
Txt2 As String 'what ever is right
Txt3 As String
Spalte1 As Integer
Spalte2 As Integer
Spalte3 As Integer
Spalte4 As Integer

'Startwert für die Spalten wie definiere ich das?
'Set Spalte1 = columnindex 15 Range("O:O")
'Set Spalte2 = columnindex 16 Range("P:P")
'Set Spalte3 = columnindex 17 Range("Q:Q")
'Set Spalte4 = columnindex 18 Range("R:R")

'Schleife??? Leider geht da nix
For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke

     With Me.Controls("txtBez" & K)
        Txt1 = Me.Value
        MsgBox valtxt 'später dann .range("Spalte1"&m_lngZeile)
        Spalte1 = Spalte1 + 4
        End If
     End With
     With Me.Controls("cbxEinheit" & K)
        cbx1 = Me.Value
        MsgBox valtxt 'später dann .range("Spalte2"&m_lngZeile)
        Spalte2 = Spalte2 + 4
        End If
     End With
       With Me.Controls("txtMenge" & K)
        Txt2 = Me.Value
        MsgBox valtxt 'später dann .range("Spalte3"&m_lngZeile)
        Spalte3 = Spalte3 + 4
        End If
     End With
     With Me.Controls("txtP" & K)
        Txt3 = Me.Value
        MsgBox valtxt 'später dann .range("Spalte4"&m_lngZeile)
        Spalte4 = Spalte4 + 4
        End If
     End With
     
Next K
End Sub

Kann mir vielleicht jemand helfen?

Liebe Grüße Nico

 

Hallo Nico,

ich nehme an, falls der 2. Code dem 1. Code entsprechen soll, dann müsste er so ähnlich wie folgt lauten:

Code:

Private Sub CommandButton22_Click()
Dim Spalte As Integer, m_lngZeile As Long
Dim K As Integer

Dim Ws As Worksheet

'Zuweisung eines Arbeitsblattes, zB.:
Set Ws = Worksheets("Auftragsdatenbank")

m_lngZeile = 10  'Vorbesetzung zB. für 10.Zeile
Spalte = 15      'Spalte "O" ist die 15. Spalte
For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke

     With Me.Controls("txtBez" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte).Value
        Spalte = Spalte + 1
     End With
     With Me.Controls("cbxEinheit" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte).Value
        Spalte = Spalte + 1
     End With
     With Me.Controls("txtMenge" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte).Value
        Spalte = Spalte + 1
     End With
     With Me.Controls("txtP" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte).Value
        Spalte = Spalte + 1
     End With
     
Next K
End Sub

 

Hallo Exl,

erst einmal vielen Dank für deine ununterbrochene Hilfe in den letzten Tagen. Jedoch kommen wir zum ersten mal an einen Punkt bei dem es nicht gleich auf anhieb klappt. Ich hoffe wir können es herausfinden.

Hier mal der ganze Code (indem der teilcode von oben eingebettet ist). Alles um das eingebettete Stück funktioniert auch wunderbar. Nur der Teil mit den vielen Textboxen auslesen klappt noch nicht

Hier der Code:

Code:

' Datensatz in Listbox1 markieren, und aus der KUNDEN-Datenbank in die Textboxen übernehmen
Private Sub ZeigeDatensatz()

Dim I As Integer
Dim e As Integer
  
With Sheets("Kunden")
  If ListBoxKunden.ListIndex = -1 Then
    txtKundennummer.Text = "Kein Kunde ausgewählt"
      
  Else

    m_lngZeile = CLng(ListBoxKunden.Column(6))
txtKundennummer = .Range("A" & m_lngZeile)
txtFirma = .Range("B" & m_lngZeile)
txtPosition = .Range("C" & m_lngZeile)
ComboBox1.Value = .Range("D" & m_lngZeile)
txtName = .Range("E" & m_lngZeile)
txtStraße = .Range("F" & m_lngZeile)
txtStadt = .Range("G" & m_lngZeile)
txtPLZ = .Range("H" & m_lngZeile)
txtTelefonnummer1 = .Range("I" & m_lngZeile)
txtTelefonnummer2 = .Range("J" & m_lngZeile)
txtTelefax = .Range("K" & m_lngZeile)
txtEmail = .Range("L" & m_lngZeile)
txtHomepage = .Range("M" & m_lngZeile)
'txtFrei = .Range("N" & m_lngZeile)

  End If
End With
  
End Sub
' Datensatz in Listbox1 markieren, und aus der AUFTRAGS-Datenbank die Werte in die Textboxen übernehmen
Private Sub ZeigeDatensatz2()

Dim I As Integer
Dim e As Integer
  
  'Checkboxen und option buttons zurück setzen sonst gehts irgendwie nicht
cbxBuKr1.Value = False
cbxBuKr2.Value = False
cbxBuKr3.Value = False
optAngebot.Value = False
optRechnung.Value = False
  
With Sheets("Auftragsdatenbank")
  If ListBoxAufträge.ListIndex = -1 Then
    TextBox100.Text = "Kein Auftrag ausgewählt"
      
  Else
    'Bestimme mir die Relevante Zeile in der Datenbank, durch die Auswahl in meiner Listbox
    m_lngZeile = CLng(ListBoxAufträge.Column(6))
    
'Option button Angebot oder Rechnung -> Auftragskategorie
    If .Range("B" & m_lngZeile) = "Angebot" Then
    optAngebot.Value = True
    ElseIf .Range("B" & m_lngZeile) = "Rechnung" Then
    optRechnung.Value = True
    End If

    'Buchungskreisauswahl - 3 Verschiedene Textboxen
    If .Range("C" & m_lngZeile) = "BK1-C" Then
    cbxBuKr1.Value = True And cbxBuKr2.Value = False And cbxBuKr3.Value = False
    ElseIf .Range("C" & m_lngZeile) = "BK2-T" Then
    cbxBuKr1.Value = False And cbxBuKr2.Value = True And cbxBuKr3.Value = False
    If .Range("C" & m_lngZeile) = "BK3-oMw" Then
    cbxBuKr1.Value = False And cbxBuKr2.Value = False And cbxBuKr3.Value = True
    End If
    
    '6er Block Textfelder im "Kopf" -Kunden/Projektinfos-
    txtKndNR.Value = txtKundennummer
    txtName2 = txtName
    txtReNummer = .Range("E" & m_lngZeile)
    txtReDatum = .Range("F" & m_lngZeile)
    txtReBezeichnung = .Range("G" & m_lngZeile)
    txtZahlEingang = .Range("H" & m_lngZeile)
    
    '6 Textfelder Gesamtübersicht: MwSt, Netto, Brutto, etc.
    txtMwSt = .Range("I" & m_lngZeile)
    txtMwStSatz = .Range("J" & m_lngZeile)
    txtNetto = .Range("K" & m_lngZeile)
    txtRabatt = .Range("L" & m_lngZeile) '
    txtRabattSatz = .Range("M" & m_lngZeile) '
    txtGesamt = .Range("N" & m_lngZeile)                                '<--------------------- Bis hier her geht es gut!

'--------Übertrag der einzelnen Rechnungsposten ----------
Dim K As Integer               ' <----- Die deklaration habe ich erstmal hier gelassen.
Dim Spalte1 As Integer      ' Sobald alles funktioniert kommt sie nach oben
Dim Spalte2 As Integer
Dim Spalte3 As Integer
Dim Spalte4 As Integer
Dim Ws As Worksheet

'Zuweisung eines Arbeitsblattes, zB.:
Set Ws = Worksheets("Auftragsdatenbank")

Spalte1 = 15      'Spalte "O" ist die 15. Spalte
Spalte2 = 16     'Spalte "P" ist die 16. Spalte
Spalte3 = 17     'Spalte "Q" ist die 17. Spalte
Spalte4 = 18     'Spalte "R" ist die 18. Spalte

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtBez" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte1).Value
        Spalte1 = Spalte1 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("cbxEinheit" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte2).Value
        Spalte2 = Spalte2 + 4  ' Alle 4 Spalten wiederholt sich die combobox
     End With
     With Me.Controls("txtMenge" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte3).Value
        Spalte3 = Spalte3 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("txtP" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte4).Value
        Spalte4 = Spalte4 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
Next K
End If

' Angebote können geändert werden Rechnungen NICHT                      <-------- Ab hier gehts auch wieder perfekt
'Command buttons sind nur beim Angebot sichtbar
'Alle Einstellungen die den Unterschied zwischen Angebot und Rechnung deutlich machen
  If optRechnung.Value = True Then
        Dim crtl As Control
        For Each crtl In Frame5.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = False
            crtl.Font.Bold = True
        Next
        ComboBox1.Enabled = False
         For Each crtl In Frame4.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = False
            crtl.Font.Bold = True
        Next
        cmdKonvertieren.Visible = False
        cmdReEntf.Visible = False
        cmdNeuesAngebot.Visible = False
        Label8.Caption = "Rechnungsnummer"
        Label9.Caption = "Rechnungsdatum"
        Frame5.BackColor = &HDCFFFD
   ElseIf optAngebot.Value = True Then
        For Each crtl In Frame5.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = True
            crtl.Font.Bold = False
        Next
        ComboBox1.Enabled = True
        For Each crtl In Frame4.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = True
            crtl.Font.Bold = False
        Next
        cmdKonvertieren.Visible = True
        cmdReEntf.Visible = True
        cmdNeuesAngebot.Visible = True
        Label8.Caption = "Angebotsnummer"
        Label9.Caption = "Angebotsdatum"
        Frame5.BackColor = &HEFFFD2
  End If
  End If

End With            'Das Programm fordert hier ein End With aber irgendwie scheint mir die Position nicht richtig?!?!
End Sub

ich hoffe ich habe alles ausreichend kommentiert damit klar wird was das ganze soll :-).

Wie gesagt das Problem bezieht sich auf diesen Teil:

Code:

'--------Übertrag der einzelnen Rechnungsposten ----------
Dim K As Integer               ' <----- Die deklaration habe ich erstmal hier gelassen.
Dim Spalte1 As Integer      ' Sobald alles funktioniert kommt sie nach oben
Dim Spalte2 As Integer
Dim Spalte3 As Integer
Dim Spalte4 As Integer
Dim Ws As Worksheet

'Zuweisung eines Arbeitsblattes, zB.:
Set Ws = Worksheets("Auftragsdatenbank")

Spalte1 = 15      'Spalte "O" ist die 15. Spalte
Spalte2 = 16     'Spalte "P" ist die 16. Spalte
Spalte3 = 17     'Spalte "Q" ist die 17. Spalte
Spalte4 = 18     'Spalte "R" ist die 18. Spalte

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtBez" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte1).Value
        Spalte1 = Spalte1 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("cbxEinheit" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte2).Value
        Spalte2 = Spalte2 + 4  ' Alle 4 Spalten wiederholt sich die combobox
     End With
     With Me.Controls("txtMenge" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte3).Value
        Spalte3 = Spalte3 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("txtP" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte4).Value
        Spalte4 = Spalte4 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
Next K
End If

es kommt keine Fehlermeldung. Der Befehl wird lediglich nicht ausgeführt oder ignoriert. Wenn ich den code so anschaue wäre meine erste vermutung dass er mit dem "Me.Controls" nicht klar kommt. die Private sub ist in einer userform. Verwechselt das Programm vielleicht die "Me's". Also kann es sein dass, das Programm denkt mit "Me" meine ich die userform. So wie in z.b. mit dem Button "cmdAbbrechen" dessen sub aus "Unload.Me" besteht???

Über weitere Hilfe würde ich mich sehr freuen

Gruß Nico


PS: mir kommt gerade dass sich die textboxen in multipage2. befinden.
darüber hinaus gibt es in der multipage 4 Seiten/Reiter. Jeder Reiter enthält 4 von den Blöcken. Macht also 12Textboxen und 4comboboxen pro reiter. falls das wichtig ist

 

Nochmal was:

ich hab im Internet gerade diesen code zum überprüfen gefunden.

Code:

Private Sub CommandButton22_Click()

Dim ctrl As Control, n As Long
For Each ctrl In Me.Controls
    If TypeName(ctrl) = "TextBox" Then
        If (ctrl.Name Like "txtBez") * (ctrl.Value <> "") Then n = n + 1
    End If
Next
MsgBox n
End Sub

die MsgBox hat leider den Wert "0" angezeigt obwohl ich in 7 "Bezeichnungstextfeldern" etwas eingetragen habe. ich habe auch bei folgender Zeile

ausprobiert ob ctrl.value oder ctrl.text etwas ändert. -> Leider nix!!!

nun weiß ich leider auch nicht mehr nach was ich noch googln könnte.
Hoffe wie immer um etwas Hilfe
Danke im vor raus

Nico

 

Hallo Nico,

bezüglich Deines letzten VBA-Makros:

Code:

  If (ctrl.Name Like "txtBez[B][COLOR=#ff0000]*[/COLOR][/B]") [COLOR=#0000cd]and [/COLOR](ctrl.Value <> "") Then n = n + 1

Ich nehme an, dass Du den rot gekennzeichneten Stern ergänzen müsstest, denn ohne jedes Maskenzeichen
sucht er auch bei "LIKE" nur nach der exakten Zeichenfolge.
Und natürlich wäre auch das blaue "and" an dieser Stelle schöner.

 

Hi Exl,

cool also dein Einwand hat gepasst. Also das Passt schonmal. Aber mit dem ersten Makro geht noch gar nix. Das Problem ist. Das Makro wird aktiviert "durck klick" auf einen listboxeintrag. Hier mal der ganze code:

Code:

' Datensatz in Listbox1 markieren, und aus der AUFTRAGS-Datenbank die Werte in die Textboxen übernehmen
Private Sub ZeigeDatensatz2()

Dim I As Integer
Dim e As Integer
  
  'Checkboxen und option buttons zurück setzen sonst gehts irgendwie nicht
cbxBuKr1.Value = False
cbxBuKr2.Value = False
cbxBuKr3.Value = False
optAngebot.Value = False
optRechnung.Value = False
txtReNummer = ""
  
With Sheets("Auftragsdatenbank")
  If ListBoxAufträge.ListIndex = -1 Then
    TextBox100.Text = "Kein Auftrag ausgewählt"
      
  Else
    'Bestimme mir die Relevante Zeile in der Datenbank, durch die Auswahl in meiner Listbox
    m_lngZeile = CLng(ListBoxAufträge.Column(6))
    
'Option button Angebot oder Rechnung -> Auftragskategorie
    If .Range("B" & m_lngZeile) = "Angebot" Then
    optAngebot.Value = True
    ElseIf .Range("B" & m_lngZeile) = "Rechnung" Then
    optRechnung.Value = True
    End If

    'Buchungskreisauswahl - 3 Verschiedene Textboxen
    If .Range("C" & m_lngZeile) = "BK1-C" Then
    cbxBuKr1.Value = True And cbxBuKr2.Value = False And cbxBuKr3.Value = False
    ElseIf .Range("C" & m_lngZeile) = "BK2-T" Then
    cbxBuKr1.Value = False And cbxBuKr2.Value = True And cbxBuKr3.Value = False
    If .Range("C" & m_lngZeile) = "BK3-oMw" Then
    cbxBuKr1.Value = False And cbxBuKr2.Value = False And cbxBuKr3.Value = True
    End If
    
    '6er Block Textfelder im "Kopf" -Kunden/Projektinfos-
    txtKndNR.Value = txtKundennummer
    txtName2 = txtName
    txtReNummer = .Range("E" & m_lngZeile)
    txtReDatum = .Range("F" & m_lngZeile)
    txtReBezeichnung = .Range("G" & m_lngZeile)
    txtZahlEingang = .Range("H" & m_lngZeile)
 MsgBox (m_lngZeile & "" & "Box1")
    '6 Textfelder Gesamtübersicht: MwSt, Netto, Brutto, etc.
    txtMwSt = .Range("I" & m_lngZeile)
    txtMwStSatz = .Range("J" & m_lngZeile)
    txtNetto = .Range("K" & m_lngZeile)
    txtRabatt = .Range("L" & m_lngZeile) '
    txtRabattSatz = .Range("M" & m_lngZeile) '
    txtGesamt = .Range("N" & m_lngZeile)                                '<--------------------- Bis hier her geht es gut!
MsgBox ("Box2")

'--------Übertrag der einzelnen Rechnungsposten ----------
Dim K As Integer               ' <----- Die deklaration habe ich erstmal hier gelassen.
Dim Spalte1 As Integer      ' Sobald alles funktioniert kommt sie nach oben
Dim Spalte2 As Integer
Dim Spalte3 As Integer
Dim Spalte4 As Integer
Dim Ws As Worksheet

'Zuweisung eines Arbeitsblattes, zB.:
Set Ws = Worksheets("Auftragsdatenbank")

Spalte1 = 15      'Spalte "O" ist die 15. Spalte
Spalte2 = 16     'Spalte "P" ist die 16. Spalte
Spalte3 = 17     'Spalte "Q" ist die 17. Spalte
Spalte4 = 18     'Spalte "R" ist die 18. Spalte

MsgBox (m_lngZeile & "" & "Box3")

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtBez" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte1).Value
        Spalte1 = Spalte1 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("cbxEinheit" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte2).Value
        Spalte2 = Spalte2 + 4  ' Alle 4 Spalten wiederholt sich die combobox
     End With
     With Me.Controls("txtMenge" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte3).Value
        Spalte3 = Spalte3 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
     With Me.Controls("txtP" & K)
        .Value = Ws.Cells(m_lngZeile, Spalte4).Value
        Spalte4 = Spalte4 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With
Next K
End If

' Angebote können geändert werden Rechnungen NICHT                      <-------- Ab hier gehts auch wieder perfekt
'Command buttons sind nur beim Angebot sichtbar
'Alle Einstellungen die den Unterschied zwischen Angebot und Rechnung deutlich machen
  MsgBox ("Box4")
  
  If optRechnung.Value = True Then
        Dim crtl As Control
        For Each crtl In Frame5.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = False
            crtl.Font.Bold = True
        Next
        ComboBox1.Enabled = False
         For Each crtl In Frame4.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = False
            crtl.Font.Bold = True
        Next
        cmdKonvertieren.Visible = False
        cmdReEntf.Visible = False
        cmdNeuesAngebot.Visible = False
        Label8.Caption = "Rechnungsnummer"
        Label9.Caption = "Rechnungsdatum"
        Frame5.BackColor = &HDCFFFD
   
   ElseIf optAngebot.Value = True Then
        For Each crtl In Frame5.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = True
            crtl.Font.Bold = False
        Next
        ComboBox1.Enabled = True
        For Each crtl In Frame4.Controls
            If crtl.Name Like "txt*" Then crtl.Enabled = True
            crtl.Font.Bold = False
        Next
        cmdKonvertieren.Visible = True
        cmdReEntf.Visible = True
        cmdNeuesAngebot.Visible = True
        Label8.Caption = "Angebotsnummer"
        Label9.Caption = "Angebotsdatum"
        Frame5.BackColor = &HEFFFD2
  End If
  End If

End With            'Das Programm fordert hier ein End With aber irgendwie scheint mir die Position nicht richtig?!?!
End Sub

ich hab folgende Probleme:

1) die For-Schleife für die 3 Textboxen und die eine Combobox geht nicht. Präzisiert: Die werte aus der source range werden nicht in die text- u. comboboxen übernommen.
2) Wenn ich aus der Listbox eine andere position anklicke bekomme ich probleme mit einer Function. Und zwar will die function etwas in eine textbox eintragen (zusammengesetzte Rechnungsnummer) weil die bedingungen erfüllt sind. Jedoch soll die function nichts eintragen sondern die textbox soll aus dem wert von dem Tabellenblatt "Auftragsdatenbank" gefüllt/geladen werden.

Code function:

Code:

'------------------------Das überschreiben der aktuellen nummer soll erst in diesem Sub passieren
    'Rechnungsnummerübertrag TEIL 1
    Dim BK As Integer
    BK = BkSelected
    With Worksheets("Versteckt")
    .Cells(3, BK) = .Cells(3, BK) + 1
    End With

End Sub
'----------------------
'Rechnungsnummerübertrag TEIL 2
Function NewNumber(BK As Integer)
   Dim Jahr As Integer
   Dim RechNr As Long
   
   With Worksheets("Versteckt")
      Jahr = .Cells(2, BK)      'Range("C2")
      RechNr = .Cells(3, BK)
      If Jahr <> Year(Date) Then
         RechNr = 0
         Jahr = Year(Date)
         .Cells(2, BK) = Jahr
         .Cells(3, BK) = RechNr
      End If
      RechNr = RechNr + 1
      NewNumber = Format(BK, "00/") & Format(RechNr, "000/") _
         & Format(Date, "YY")
   End With
End Function
'Rechnungsnummerübertrag TEIL 3
Function BkSelected()
   With Me
      If .cbxBuKr1 Then
         BkSelected = 1
      ElseIf .cbxBuKr2 Then
         BkSelected = 2
      ElseIf .cbxBuKr3 Then
         BkSelected = 3
      End If
   End With
End Function
'Rechnungsnummerübertrag TEIL 4
Private Sub cbxBuKr1_Click()
   Dim BkAuswahl As Integer
        If cbxBuKr1 = True Then
        cbxBuKr2 = False
        cbxBuKr3 = False
        End If
   BkAuswahl = BkSelected
   txtReNummer = NewNumber(BkAuswahl)
End Sub
'Rechnungsnummerübertrag TEIL 5
Private Sub cbxBuKr2_Click()
   Dim BkAuswahl As Integer
        If cbxBuKr2 = True Then
        cbxBuKr3 = False
        cbxBuKr1 = False
        End If
    BkAuswahl = BkSelected
    txtReNummer = NewNumber(BkAuswahl)
End Sub
'Rechnungsnummerübertrag TEIL 6
Private Sub cbxBuKr3_Click()
   Dim BkAuswahl As Integer
        If cbxBuKr3 = True Then
        cbxBuKr2 = False
        cbxBuKr1 = False
        End If
   BkAuswahl = BkSelected
   txtReNummer = NewNumber(BkAuswahl)
End Sub

kann man mir eig noch folgen :)? Ich hoffe ich formuliere alles einigermaßen in ordnung

 

Hallo Nico,

1) Das kann ich leider nicht wirklich glauben! Denn einige Codezeilen oberhalb findet sich folgende Passage:

Code:

      'Buchungskreisauswahl - 3 Verschiedene Textboxen
      If .Range("C" & m_lngZeile) = "BK1-C" Then
        cbxBuKr1.Value = True And cbxBuKr2.Value = False And cbxBuKr3.Value = False
      ElseIf .Range("C" & m_lngZeile) = "BK2-T" Then
        cbxBuKr1.Value = False And cbxBuKr2.Value = True And cbxBuKr3.Value = False
      If .Range("C" & m_lngZeile) = "BK3-oMw" Then
        cbxBuKr1.Value = False And cbxBuKr2.Value = False And cbxBuKr3.Value = True
      End If

Diese kann so nicht funktionieren. Vermutlich sollte sie so lauten:

Code:

      'Buchungskreisauswahl - 3 Verschiedene Textboxen
      If .Range("C" & m_lngZeile) = "BK1-C" Then
        cbxBuKr1.Value = True
        cbxBuKr2.Value = False
        cbxBuKr3.Value = False
      ElseIf .Range("C" & m_lngZeile) = "BK2-T" Then
        cbxBuKr1.Value = False
        cbxBuKr2.Value = True
        cbxBuKr3.Value = False
      ElseIf .Range("C" & m_lngZeile) = "BK3-oMw" Then
        cbxBuKr1.Value = False
        cbxBuKr2.Value = False
        cbxBuKr3.Value = True
      End If

was aber um einiges schöner und effizienter so lautet:

Code:

      'Buchungskreisauswahl - 3 Verschiedene Textboxen
      Select Case .Range("C" & m_lngZeile)
       Case "BK1-C"
        cbxBuKr1.Value = True
        cbxBuKr2.Value = False
        cbxBuKr3.Value = False
       Case "BK2-T"
        cbxBuKr1.Value = False
        cbxBuKr2.Value = True
        cbxBuKr3.Value = False
       Case "BK3-oMw"
        cbxBuKr1.Value = False
        cbxBuKr2.Value = False
        cbxBuKr3.Value = True
       Case Else
        'Anweisungen, falls sonstiger Wert
        '....
      End Select

2) Was mir weiter aufgefallen ist: Stimmt es, dass folgendes "END IF" in der letzten Zeile

Code:

       With Me.Controls("txtP" & K)
          .Value = Ws.Cells(m_lngZeile, Spalte4).Value
          Spalte4 = Spalte4 + 4 ' Alle 4 Spalten wiederholt sich die textbox
       End With
  Next K
  End If

zu diesem "IF/ELSE"-Statement ganz am Anfang des Codelistings gehört?

Code:

    If ListBoxAufträge.ListIndex = -1 Then
      TextBox100.Text = "Kein Auftrag ausgewählt"
    Else
      'Bestimme mir die Relevante Zeile in der Datenbank, durch die Auswahl in meiner Listbox
      m_lngZeile = CLng(ListBoxAufträge.Column(6))

oder gehört dieses "END IF" vielleicht schon wo früher platziert?

3) Du schreibst als Kommentar Folgendes:

Code:

  End With            'Das Programm fordert hier ein End With aber irgendwie scheint mir die Position nicht richtig?!?!
  End Sub

Du hast ziemlich am Anfang Deines Codes folgenden Abschnitt:

Code:

  optRechnung.Value = False
  txtReNummer = ""
    
  [COLOR=#ff0000][B]With [/B]Sheets("Auftragsdatenbank")[/COLOR]
    If ListBoxAufträge.ListIndex = -1 Then

Mit diesem "WITH" beginnst Du einen With-Block, der zwingend mit einem "END WITH" zu beenden ist - und zwar spätestens vor einem "END SUB".
Da Du das offenbar nicht getan hast, bleibt dem Compiler nichts anderes übrig, als dies anzumahnen. Da er jedoch nicht wissen kann, wo das "END WITH" wirklich hingehört, tut er das an der letztmöglichen Stelle.
Ich nehme an, dass Du die Wirkungsweise eines "WITH ... END WITH"-Blockes kennst.

4) Anmerkung zum "Me"-Objektzeiger:
Befindet sich das "Me" in einem Codemodul für eine Userform, meint das Me die Userform und sonst nichts.
Befindet sich das "Me" in einem Codemodul für ein Arbeitsblatt, meint das Me das nämliche Arbeitsblatt und sonst nichts, auch nicht ein anderes Arbeitsblatt.
Befindet sich das "Me" in einem Codemodul für eine Arbeitsmappe (zB. "DieseArbeitsmappe" oder "ThisWorkbook"), meint das Me genau diese Arbeitsmappe, in deren Codemodul es enthalten ist.
Dagegen enthält ein allgemeines Codemodul kein Me.
Häufig kann aber dieses Me weggelassen werden, da es aufgrund des eindeutigen Kontextes vom Compiler automatisch eingesetzt wird (per Default).
Ein flexiblerer Einsatz des Me (wie zB. des "SELF" in ObjectPascal/Delphi) ist in VBA unbekannt.

Das sind 3 Probleme, die auf alle Fälle geklärt gehören. Vielleicht wird dadurch bereits das eine oder andere seltsame Verhalten des Codes beseitigt.

 

Hallo Anton,

Super klasse vielen Dank! Jetzt läuft alles prima :). Zum thema eleganz, schönheit und effizienz. Ich habe hier einen code aus dem Internet gefunden und für mich angepasst. Er funktioniert auch. Das Problem ist jetzt er ist noch nicht fertig und würde auch wieder viel schreibaufwand benötigen. Jetzt suche ich nach einer Lösung um nicht so "deletantisch" zu programmieren.

Code:

Private Sub cmdBerechnung_Click()
    'Berechnung der Rechnungswerte: MwSt, Netto, Gesamt
'Alle Variablen als Zahlen
  Dim sngStunden As Single
  Dim sngStundenSatz As Single
  Dim sngKm As Single
  Dim sngKmSatz As Single
  Dim sngSonstiges As Single
  Dim sngUnterkunft As Single
  Dim sngVerpflegung As Single
  Dim sngZwStd As Single
  Dim sngZwKm As Single
  Dim sngZwSpesen As Single
  Dim sngNetto As Single
  Dim sngMwSt As Single
  Dim sngGesamt As Single
  Dim sngRabatt As Single
  
  
' Zuweisungen damit die Textbox erkennt dass es Zahlen sind
  If IsNumeric(txtStd.Text) Then                       '1
    sngStunden = CSng(txtStd.Text)
  End If
  If IsNumeric(txtStdSatz.Text) Then                 '2
    sngStundenSatz = CSng(txtStdSatz.Text)
  End If
  If IsNumeric(txtKm.Text) Then                       '3
    sngKm = CSng(txtKm.Text)
  End If
    If IsNumeric(txtKmSatz.Text) Then              '4
    sngKmSatz = CSng(txtKmSatz.Text)
  End If
    If IsNumeric(txtSonstiges.Text) Then           '5
    sngSonstiges = CSng(txtSonstiges.Text)
  End If
    If IsNumeric(txtUnterkunft.Text) Then         '6
    sngUnterkunft = CSng(txtUnterkunft.Text)
  End If
  If IsNumeric(txtVerpflegung.Text) Then        '7
    sngVerpflegung = CSng(txtVerpflegung.Text)
  End If
  If IsNumeric(txtZwStd.Text) Then                  '8
    sngZwStd = CSng(txtZwStd.Text)
  End If
    If IsNumeric(txtZwKm.Text) Then                 '9
    sngZwKm = CSng(txtZwKm.Text)
  End If
    If IsNumeric(txtZwSpesen.Text) Then         '10
    sngZwSpesen = CSng(txtZwSpesen.Text)
  End If
    If IsNumeric(txtNetto.Text) Then                '11
    sngNetto = CSng(txtNetto.Text)
  End If
    If IsNumeric(txtMwSt.Text) Then                 '12
    sngMwSt = CSng(txtMwSt.Text)
  End If
    If IsNumeric(txtGesamt.Text) Then              '13
    sngGesamt = CSng(txtGesamt.Text)
  End If
      If IsNumeric(txtRabatt.Text) Then            '14
    sngRabatt = CSng(txtRabatt.Text)
  End If
  
'---------------------- Zwischensummen ---------------
'Berechnung Zwischensumme der Grundleistung
        sngZwStd = sngStunden * sngStundenSatz
        txtZwStd.Text = Format(sngZwStd, "0.00")
'Berechnung Zwischensumme der Fahrtkosten
        sngZwKm = sngKm * sngKmSatz
        txtZwKm.Text = Format(sngZwKm, "0.00")
'Berechnung Zwischensumme Spesen
        sngZwSpesen = sngVerpflegung + sngUnterkunft + sngSonstiges
        txtZwSpesen.Text = Format(sngZwSpesen, "0.00")
'---------------------- Gesamtwerte--------------------
'Berechnung Netto
        sngNetto = sngZwStd + sngZwKm + sngZwSpesen
        txtNetto.Text = Format(sngNetto, "0.00")
'Berechnung MwSt
        sngMwSt = sngNetto * (txtMwStSatz.Value / 100)
        txtMwSt.Text = Format(sngMwSt, "0.00")
'Berechnung Rabatt
        sngRabatt = sngNetto * (txtRabattSatz.Value / 100)
        txtRabatt.Text = Format(sngRabatt, "0.00")
'Berechnung Gesamt
        sngGesamt = sngNetto + sngMwSt - sngRabatt
        txtGesamt.Text = Format(sngGesamt, "0.00")
'----------------------------------------------------
End Sub

wie man in meiner ersten Version sehen kann, liste ich alles einmal auf. Gibt es da nicht die Möglichkeit sowas in der Art zu machen? Z.b. so?:

Code:

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtZw" & K)
        .Value = CSng(txtEinheit & K.Text) * CSng(txtP & K.Text)
     End With
     
  For T = 0 To 15
        With Me.Controls("txtNetto" & K)
            .vlaue = CSng(txtZw & K.Text)
            .value = .value + CSng(txtZw & K+1.Text)

Der Code wird momentan nicht akzeptiert. Die letzte Zeile wird mir auch dirket als rot markiert. Ich denke es liegt an der Syntax wie ich die Textboxen in der Klammer benennen muss. Oder formuliere ich das falsch?

und eine weitere Frage (sorry dass ich da nicht selber drauf komme). Sagen wir ich möchte das meine Textbox nun nicht mehr werte ausließt sondern ins Tabellenblatt schreibt. kann ich dann auch einfach den code umdrehen?

Code:

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtBez" & K)
       Ws.Cells(m_lngZeile, Spalte1).Value = .Value
        Spalte1 = Spalte1 + 4 ' Alle 4 Spalten wiederholt sich die textbox
     End With

Wenn ja dann setzte ich in dem betreffenden Sub auch ein neues Makro auf.

Über weiterhin so excellente Hilfe würde ich mich sehr freuen

Gruß und schönes Wochenende
Nico

 

Hallo Nico,

Code:

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtZw" & K)
        .Value = CSng(txtEinheit & K.Text) * CSng(txtP & K.Text)
     End With
     
  For T = 0 To 15
        With Me.Controls("txtNetto" & K)
            .vlaue = CSng(txtZw & K.Text)
            .value = .value + CSng(txtZw & K+1.Text)

1) Dein Code müsste unter der Voraussetzung, dass es wirklich stimmt, dass Du 2 ineinander verschachtelte FOR-Schleifen haben möchtest (äußere Schleife mit K=1 bis 16 und innere Schleife mit T=0 bis 15) so umgeschrieben werden:

Code:

For K = 1 To 16 ' Ich hab 16 Rechnungsposten blöcke
     With Me.Controls("txtZw" & K)
        .Value = CSng(Me.Controls("txtEinheit" & K).Text) * CSng(Me.Controls("txtP" & K).Text)
     End With

  For T = 0 To 15
        With Me.Controls("txtNetto" & K)
            .Value = CSng(Me.Controls("txtZw" & K).Text)
            .Value = .Value + CSng(Me.Controls("txtZw" & (K + 1)).Text)
            '....
            '....
        End With
        '....
        '....
  Next T
Next K

2) Was das Schreiben ins Arbeitsblatt betrifft, ist es natürlich möglich, dies so zu tun.

 

Hallo Anton,

danke für den Hinweis mit der zweiten Schleife. Ich habe mir die Logik noch einmal angeschaut und erstens macht es keinen Sinn die Schleifen hier ineinander zu verschachteln und zweitens kann die schleife nicht von 0 anfangen da ich keine "txtBez0" auf der userform habe.

Ich habe den code nun folgendermaßen geändert. Jedoch stelle ich fest dass er nur dann funktioniert wenn alle txtMenge u. txtP (von 1 bis 16) beschrieben sind. Daher hatte ich versucht folgende If ergänzung zu implementieren. Aber jetzt meckert er die ganze Zeit über den Laufzeichenfehler 13 "Typenkonflikt" und markiert mir die Zeile in der ich das If platziert habe. Das hat mich verwundert und ich habe die Zeile herausgenommen. Dann meckert er trotzdem mit der identischen fehlermeldung und markiert die zeile mit .Value = CSng (also die Zeile darunter).

Code:

Private Sub cmdBerechnung_Click()
Dim K As Integer
Dim T As Integer
Dim NettoW As Single
  Dim sngNetto As Single
  Dim sngMwSt As Single
  Dim sngGesamt As Single
  Dim sngRabatt As Single
  
  
'Schleife für die Zwischenwerte und den Nettobetrag
For K = 1 To 16
     With Me.Controls("txtZw" & K)
     If Me.Controls("txtMenge" & K).Value And Me.Controls("txtP" & K).Value <> "" Then
        .Value = CSng(Me.Controls("txtMenge" & K).Text) * CSng(Me.Controls("txtP" & K).Text)
        Else
         .Value = 0
         End If
     End With
Next K
  For T = 1 To 15
        With Me.Controls("txtZw" & T)
            .Value = CSng(Me.Controls("txtZw" & T).Text)
            NettoW = CSng(Me.Controls("txtZw" & T).Text) + CSng(Me.Controls("txtZw" & (T + 1)).Text)
        End With
  Next T

'Nettobetrag
txtNetto.Value = Format(NettoW, "0.00")
'Berechnung MwSt
        sngMwSt = NettoW * (txtMwStSatz.Value / 100)
        txtMwSt.Text = Format(sngMwSt, "0.00")
'Berechnung Rabatt
        sngRabatt = NettoW * (txtRabattSatz.Value / 100)
        txtRabatt.Text = Format(sngRabatt, "0.00")
'Berechnung Gesamt
        sngGesamt = NettoW + sngMwSt - sngRabatt
        txtGesamt.Text = Format(sngGesamt, "0.00")

End Sub

So von meinem Basis verständnis würde ich auf ein deklarationsproblem tippen, weil wenn ich in den Dim-Block reinschaue sehe ich keinen verweis darauf dass es sich bei den txt-Boxen um "Objects" handelt. Aber ich kann ja nicht sagen: Dim "txtMenge" & K as Object

Hast du vielleicht eine Idee woran es liegen könnte? Ich kann die Lösung schon förmlich riechen :). Ich bin auf jedenfall schon SUPER Happy dass, das Auslesen der Textboxen mit der Schleife funktioniert. Ich muss mich auch noch einmal ausdrücklich bedanken dass du mir so weiter hilfst. Ich lerne gerade sehr viel.

Liebe Grüße und einen Guten Start in die Woche

 

Hallo Nico,

wenn Du im "Direktbereich"-Fenster folgenden Ausdruck eingibst:
?CSng("")
wird genau dieser Fehler angezeigt, weil er nämlich bei der CSNG()-Funktion eine leere Zeichenkette nicht zulässt. Genau das Gleiche gilt auch, wenn Du bei einem Formularfeld statt der .Text-Methode die .Value-Methode nimmst. Um dem Problem zu entkommen, ist es am einfachsten, in ein allgem.Codemodul folgende Funktion aufzunehmen:

Code:

Function NzBl(Vl As String, Optional VlLeer As String = "0") As String
  If Len(Vl) Then
    NzBl = Vl
  Else
    NzBl = VlLeer
  End If
End Function

Wenn Du jetzt im Direktbereich-Fenster folgenden Ausdruck eingibst:
?CSng(NzBl(""))
kommt keine Fehlermeldung mehr und Du erhältst als Resultat ' 0' angezeigt.
Durch den Einbau der NzBl(..)-Funktion ersparst Du Dir die Abfrage, ob irgendwelche Formularfelder leer sind. Durch diese Funktion wird aus einem Formularfeld, das eine leere Zeichenkette enthält, der Zeichenketten-Wert "0" ermittelt. Und Du kannst, um bei Deinem obigen Problem zu bleiben, statt

Code:

'Schleife für die Zwischenwerte und den Nettobetrag
For K = 1 To 16
     With Me.Controls("txtZw" & K)
     If Me.Controls("txtMenge" & K).Value And Me.Controls("txtP" & K).Value <> "" Then
        .Value = CSng(Me.Controls("txtMenge" & K).Text) * CSng(Me.Controls("txtP" & K).Text)
        Else
         .Value = 0
         End If
     End With
Next K

folgendermaßen programmieren:

Code:

'Schleife für die Zwischenwerte und den Nettobetrag
For K = 1 To 16
     With Me.Controls("txtZw" & K)
        .Value = CSng(NzBl(Me.Controls("txtMenge" & K).Text)) * CSng(NzBl(Me.Controls("txtP" & K).Text))
     End With
Next K

(Anmerkung: Sollte das Direktbereich-Fenster nicht sichtbar sein im VBA-Editor, brauchst Du nur die Tastenkombination Strg+G zu drücken, um es anzuzeigen).

 

Hallo Anton,

abermals vielen herzlichen Dank für die Erklärung. Jetzt macht das natürlich Sinn warum es nicht geht. Mit der "Function" treten für mich ganz neue Ideen auf. Ich bin "damit" nun zum zweiten mal in Berührung gekommen und habe mich darauf hin eingelesen. Mein nächstes Projekt ist nun (um die Function-Befehle besser kenen zu lernen), "unterlege die aktiv ausgewählte Textbox mit einem leichten Gelb".
Dazu muss ich mich aber erst im internet einlesen. Ich denke mein "nicht funktionierender code" kommt dann schnell genug :).

Um dieses Thema hier noch mit einer letzten Anschlussfrage zu beenden wollte ich folgendes noch fragen:

Code:

 With Sheets("Kunden")
 Dim rngKuZelle As Long

        Set rngKuZelle = Worksheets("Kunden").Range("A:A").Find(What:=txtKundennummer.Value, LookIn:=xlValues, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Rows
        If (rngKuZelle Is Nothing) Then
           MsgBox ("Es ist ein Fehler aufgetreten")
           Exit Sub
        Else
            
            MsgBox ("Der Kunde ist in Zeile" & "" & rngKuZelle & "" & "gelistet")

Ich habe folgendes Problem: Ich würde gerne im sheet "Kunden" nach der Kundennummer suchen und der Variable gerne den Wert der gefundenen Zeile zuweisen.

Den code habe ich aus einer passage in der ich nur danach schaue ob die Kundennummer vorhanden ist oder nicht. Im internet habe ich dann noch zusätze wie "search order/direction" gefunden.
Der Fehler ist dass, ich die var. gerne als Long hätte. Ich muss sie aber als Range deklarieren. Ergo, meine "füllung" der variablen ist eine Range. Die frage ist nun wie ich "Set rngKuZelle = ..." dazu bekomme mir:
1. Nicht den Wert der Kundennummer auszugeben (das überprüfe ich gerade immer mit der msgbox)
2. Den Wert der Reihe auszugeben inder sich die gesuchte Kundennummer befindet.

Sobald ich den Wert rngKuZelle habe kann ich wieder 10 Textboxen über: "ComboBox1.Value = .Range("D" & rngKuZelle)", in dem selben With-Block auslesen lassen.

Über deine weitere Hilfestellungen würde ich mich sehr freuen.

Gruß Nico

 

Hallo Nico,

Du musst Deinen Codeabschnitt in etwa so umgestalten:

Code:

Dim rngKuZelle As Range
Dim lngKuZeile As Long

With Worksheets("Kunden")
        Set rngKuZelle = .Range("A:A").Find(What:=txtKundennummer.Value, LookIn:=xlValues, _
                         SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        If (rngKuZelle Is Nothing) Then
           MsgBox Title:="Es ist ein Fehler aufgetreten", _
                  Prompt:="Die Kundennr. " & txtKundennummer.Value & " wurde nicht gefunden."
           Exit Sub
        Else
           lngKuZeile = rngKuZelle.Row
           MsgBox ("Der Kunde ist in Zeile " &  lngKuZeile & " gelistet")
        End If
End With

 

Hallo Anton,

vielen herzlichen Dank für die korrektur. Jetzt komme ich mir etwas dumm vor dass ich nicht selber darauf gekommen bin eine neue variable einfach als Long zu definieren.
Es funktioniert auf jeden Fall und nun gönne ich dir erst einmal eine wohlverdiente Pause von mir. Die nächste Woche über habe ich leider Keine Zeit mehr an dem kleinen "Hobby-Projekt" weiter zu arbeiten.
Jedenfalls kommt bald noch ein Übertrag der Rechnungsdaten in ein Rechnungsformular, die aktive Textbox farblich zu unterlegen und noch zwei drei Rechnungen mit Datumswerten. Also noch jede MEnge Arbeit :).

Noch einmal herzlichen Dank für deinen langen Atem und die vielen Hilfen und Erklärungen. Ich hoffe du kannst auch etwas meinen Fortschritt sehen dass die notwendigen Korrekturen immer kleiner werden und ich etwas mehr Verständnis entwickeln konnte.

Gruß und eine schöne Restwoche

Nico