Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

Forumthread: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 09:59:57

Fendt716

Das ist der Code. Kann man diesen Code kürzen oder besser schreiben?

Private Sub Schließen_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim CB As Object
Dim CV As Object
Dim CH As Object

With Me.ComboBox_Probeart
.AddItem "G=Grundnährstoffe"
.AddItem "N=N-Min"
.AddItem "B=Beides"
End With

With Me.ComboBox_Bewirtschaftungseinheit
.AddItem "Ja"
.AddItem "Nein"
.AddItem "Beantragt"
End With

With Me.ComboBox_Feldgrenzen
.AddItem "Ja"
.AddItem "Nein"
.AddItem "Beantragt"
End With

For I = 1 To 50
Set CB = UserForm1.Controls("ComboBox_Kultur_" & I)
CB.AddItem "A=Acker"
CB.AddItem "W=Grünland/Weide"
CB.AddItem "F=Forst"
CB.AddItem "S=Spargel"
CB.AddItem "O=Obst"
Next I

For I = 1 To 50
Set CV = UserForm1.Controls("ComboBox_Vorfrucht_" & I)
Set CH = UserForm1.Controls("ComboBox_Hauptfrucht_" & I)
CV.AddItem "Ackerbohne"
CH.AddItem "Ackerbohne"
CV.AddItem "Gerste"
CH.AddItem "Gerste"
CV.AddItem "Gras"
CH.AddItem "Gras"
CV.AddItem "Hafer"
CH.AddItem "Hafer"
CV.AddItem "Kartoffel"
CH.AddItem "Kartoffel"
CV.AddItem "Mais"
CH.AddItem "Mais"
CV.AddItem "Raps"
CH.AddItem "Raps"
CV.AddItem "Roggen"
CH.AddItem "Roggen"
CV.AddItem "Sonnenblume"
CH.AddItem "Sonnenblume"
CV.AddItem "Triticale"
CH.AddItem "Triticale"
CV.AddItem "Weizen"
CH.AddItem "Weizen"
CV.AddItem "Zuckerrübe"
CH.AddItem "Zuckerrübe"
CV.AddItem "Zwischenfrucht"
CH.AddItem "Zwischenfrucht"
Next I

End Sub

Private Sub Speichern_Click()

Dim A As Integer
Dim B As Object
Dim C As Object
Dim D As Object
Dim E As Object
Dim F As Object
Dim G As Object
Dim H As Object
Dim J As Object
Dim K As Object
Dim L As Object
Dim M As Object
Dim N As Object
Dim O As Object
Dim P As Object
Dim Q As Object
Dim R As Object
Dim S As Object
Dim T As Object
Dim U As Object
Dim V As Object
Dim W As Object
Dim Y As Object

'MsgBox "Das Speichern kann etwas dauern (ca. 3-5 Minuten). Bitte kein Fenster oder ähnliches schließen. Man kann allerdings andere Sachen z.B.(Internet) weiter nutzen. ", vbExclamation, "Wichtige Information"

Dim StartZeile&
Dim Ws As Worksheet
Set Ws = Sheets("Datenpool")
StartZeile = Ws.Cells(Rows.Count, 3).End(xlUp).Row + 1
StarteZeile = ActiveCell.Row + 1

'Allgemeine Informationen zum Landwirt
Ws.Cells(StartZeile, 3) = Text_Name
Ws.Cells(StartZeile, 6) = Text_Strasse
Ws.Cells(StartZeile, 7) = Text_Postleitzahl
Ws.Cells(StartZeile, 8) = Text_Ort
Ws.Cells(StartZeile, 9) = Text_E_Mail
Ws.Cells(StartZeile, 10) = Text_Telefonnummer

'Comboboxen Feldgrenze etc
If ComboBox_Probeart = "G=Grundnährstoffe" Then
Ws.Cells(StartZeile, 18) = "G"
ElseIf ComboBox_Probeart = "N=Nmin" Then
Ws.Cells(StartZeile, 18) = "N"
ElseIf ComboBox_Probeart = "B=Beides" Then
Ws.Cells(StartZeile, 18) = "B"
Else
Ws.Cells(StartZeile, 18) = ""
End If
Ws.Cells(StartZeile, 19) = ComboBox_Feldgrenzen
Ws.Cells(StartZeile, 20) = ComboBox_Bewirtschaftungseinheit

'Feld Details
A = 22
For I = 1 To 50
Set B = UserForm1.Controls("Text_Flächenbezeichnung_" & I)
Set C = UserForm1.Controls("ComboBox_Kultur_" & I)
Set D = UserForm1.Controls("ComboBox_Vorfrucht_" & I)
Set E = UserForm1.Controls("ComboBox_Hauptfrucht_" & I)
Set F = UserForm1.Controls("TextBox_weitere_Infos_" & I)
Set G = UserForm1.Controls("CheckBox_PH_" & I)
Set H = UserForm1.Controls("CheckBox_Na_" & I)
Set Y = UserForm1.Controls("CheckBox_Cu_" & I)
Set J = UserForm1.Controls("CheckBox_B_" & I)
Set K = UserForm1.Controls("CheckBox_Mn_" & I)
Set L = UserForm1.Controls("CheckBox_Zn_" & I)
Set M = UserForm1.Controls("CheckBox_CAT_Paket_" & I)
Set N = UserForm1.Controls("CheckBox_PFR_" & I)
Set O = UserForm1.Controls("CheckBox_Humus_" & I)
Set P = UserForm1.Controls("CheckBox_C_N_" & I)
Set Q = UserForm1.Controls("CheckBox_Körnung_" & I)
Set R = UserForm1.Controls("CheckBox_N_30_" & I)
Set S = UserForm1.Controls("CheckBox_N_60_" & I)
Set T = UserForm1.Controls("CheckBox_N_90_" & I)
Set U = UserForm1.Controls("CheckBox_S_30_" & I)
Set V = UserForm1.Controls("CheckBox_S_60_" & I)
Set W = UserForm1.Controls("CheckBox_S_90_" & I)

If B > "" Then
'Flächenbezeichnung
Ws.Cells(StartZeile, 23 + A) = B
'Kultur
If C = "A=Acker" Then
Ws.Cells(StartZeile, 24 + A) = "A"
ElseIf C = "W=Grünland/Weide" Then
Ws.Cells(StartZeile, 24 + A) = "W"
ElseIf C = "F=Forst" Then
Ws.Cells(StartZeile, 24 + A) = "F"
ElseIf C = "O=Obst" Then
Ws.Cells(StartZeile, 24 + A) = "O"
ElseIf C = "S=Spargel" Then
Ws.Cells(StartZeile, 24 + A) = "S"
Else
Ws.Cells(StartZeile, 24 + A) = ""
End If
'Vorfrucht
Ws.Cells(StartZeile, 25 + A) = D
'Hauptfrucht
Ws.Cells(StartZeile, 26 + A) = E
'Weitere Infos
Ws.Cells(StartZeile, 27 + A) = F
'PH Wert
If G = True Then
Ws.Cells(StartZeile, 28 + A) = "X"
Else
Ws.Cells(StartZeile, 28 + A) = ""
End If
'Na
If H = True Then
Ws.Cells(StartZeile, 29 + A) = "X"
Else
Ws.Cells(StartZeile, 29 + A) = ""
End If
'Cu
If Y = True Then
Ws.Cells(StartZeile, 30 + A) = "X"
Else
Ws.Cells(StartZeile, 30 + A) = ""
End If
'B
If J = True Then
Ws.Cells(StartZeile, 31 + A) = "X"
Else
Ws.Cells(StartZeile, 31 + A) = ""
End If
'Mn
If K = True Then
Ws.Cells(StartZeile, 32 + A) = "X"
Else
Ws.Cells(StartZeile, 32 + A) = ""
End If
'Zn
If L = True Then
Ws.Cells(StartZeile, 33 + A) = "X"
Else
Ws.Cells(StartZeile, 33 + A) = ""
End If
'CAT Paket
If M = True Then
Ws.Cells(StartZeile, 34 + A) = "X"
Else
Ws.Cells(StartZeile, 34 + A) = ""
End If
'PFR²
If N = True Then
Ws.Cells(StartZeile, 35 + A) = "X"
Else
Ws.Cells(StartZeile, 35 + A) = ""
End If
'Humus
If O = True Then
Ws.Cells(StartZeile, 36 + A) = "X"
Else
Ws.Cells(StartZeile, 36 + A) = ""
End If
'C/N
If P = True Then
Ws.Cells(StartZeile, 37 + A) = "X"
Else
Ws.Cells(StartZeile, 37 + A) = ""
End If
'Körnung
If Q = True Then
Ws.Cells(StartZeile, 38 + A) = "X"
Else
Ws.Cells(StartZeile, 38 + A) = ""
End If
'Nmin 30 cm
If R = True Then
Ws.Cells(StartZeile, 39 + A) = "X"
Else
Ws.Cells(StartZeile, 39 + A) = ""
End If
'Nmin 60 cm
If S = True Then
Ws.Cells(StartZeile, 40 + A) = "X"
Else
Ws.Cells(StartZeile, 40 + A) = ""
End If
'Nmin 90 cm
If T = True Then
Ws.Cells(StartZeile, 41 + A) = "X"
Else
Ws.Cells(StartZeile, 41 + A) = ""
End If
'Smin 30 cm
If U = True Then
Ws.Cells(StartZeile, 42 + A) = "X"
Else
Ws.Cells(StartZeile, 42 + A) = ""
End If
'Smin 60 cm
If V = True Then
Ws.Cells(StartZeile, 43 + A) = "X"
Else
Ws.Cells(StartZeile, 43 + A) = ""
End If
'Smin 90 cm
If W = True Then
Ws.Cells(StartZeile, 44 + A) = "X"
Else
Ws.Cells(StartZeile, 44 + A) = ""
End If
Else
Exit For
End If
A = A + 23
Next I

Unload Me
Sheets("Datenpool").Select

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 10:38:09

Alwin Weisangler

Hallo,

mal als Beispiel für das Füllen der 50 Comboboxen, wäre dies so:



    Dim i&, j&, arrList()

    arrList = Array("Ackerbohne", "Ackerbohne", "Gerste", "Gerste", "Gras", "Gras", "Hafer", "Hafer", "Kartoffel", _

    "Kartoffel", "Mais", "Mais", "Raps", "Raps", "Roggen", "Roggen", "Sonnenblume", "Sonnenblume", "Triticale", _

    "Triticale", "Weizen", "Weizen", "Zuckerrübe", "Zuckerrübe", "Zwischenfrucht", "Zwischenfrucht")

    For i = 1 To 50

        Controls("ComboBox_Vorfrucht_" & i).List = arrList

        Controls("ComboBox_Hauptfrucht_" & j).List = arrList

    Next i

Es wird den Speicherüberlauf nicht beseitigen. Die Ursache dafür liegt vermutlich in den vielen Objektvariablen, welche so nicht erforderlich sind.

Gruß Uwe

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 12:22:47

Daniel

Was soll der Code denn genau machen?
Ist das, was du zeigst, der vollständige Code oder gibt es noch weiteren Code?
Wofür brauchst du so viele Comboboxen mit gleichem Inhalt?

Was man am Code vereinfachen kann?
Ich würde das ganze Initialize-Event einsparen:
1. Lege ein Zusätzliches Tabellenblatt an
Schreibe da jeden Comboboxinhalt in eine Spalte. Wenn mehrere Comboboxen den selben Inhalt bekommen, muss du diesen nur einmal hinschreiben.
2. Schreibe dann in die Eigenschaft "RowSource" die Adresse des Zellbereichs, in dem die Werte für die Combobox stehen, verwende die vollständige Adresse, also mit Tabellenblatt davor (TabelleX!A1:A10)
Wenn mehrere Boxen den selben Inhalt bekommen, kannst du sie auch zuerst als Gruppe selektieren.

Do ... Loop

23.12.2024 12:48:42

snb

Ich vermute: du hast ein Endloschleife drin.

Comboboxen als Alternativ

23.12.2024 12:51:16

snb

Studiere mal was man mit Comboboxen machen kann

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 12:29:25

Fendt 716

Der Code ist als Dateneingabe gedacht. Wo der Kunde sozusagen bis zu 50 Flächen beproben kann und es ist halt pro Feld individuell wählbar as dort gemacht werden soll. Daher sind es auch so viele Boxen.

Userbild

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 15:33:18

Alwin Weisangler

Hallo,

ich habe mal deinen ursprünglichen Intialize Teil umgebaut. auf meiner alten Karre von Rechner gibt es keine Probleme.
https://www.herber.de/bbs/user/174484.xlsm

Die Sache mit dem Speichern kann man ebenfalls stark optimieren, so dass man zumindest Blockweise (siehe Schleifen) die Ausgaben in einem Array sammelt und via Resize blockweise schreibt.

Gruß Uwe

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 18:23:13

Piet

Hallo

ab hier kann man am Code auch einiges einsparen. Lösche Startzeile 28+A bis 44+A komplett VOR der If Anweisung.
Dann kannst du mit ElseIF für alle Buchstaben von G bis W die Werte gezielt auf "X" setzen.
If G = True Then
Ws.Cells(StartZeile, 28 + A) = "X"
Else
Ws.Cells(StartZeile, 28 + A) = ""
End If

Ab hier mit ElseIf weitermachen
If G = True Then
Ws.Cells(StartZeile, 28 + A) = "X"
ElseIf H = True then --> usw.
Ws.Cells(StartZeile, 29 + A) = "X"

Noch einfacher wäre es, dir alle ComboBoxen in eine Tabelle auflisten, und sie mit For Next als Schleife abfragen, indem du dir den Control Namen aus der Tabelle holst. z.B. "CheckBox_PH_" usw. - Dann hast du nur eine For Next Schleife. Da genügt zum Daten einlesen eine eizige Variable, Statt Dim Von A bis W als Objekt anzulegen.

mfg Piet

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 10:41:11

Alwin Weisangler

sorry,

da war noch eine Zählvriable falsch.



    Dim i&, arrList()

    arrList = Array("Ackerbohne", "Ackerbohne", "Gerste", "Gerste", "Gras", "Gras", "Hafer", "Hafer", "Kartoffel", _

    "Kartoffel", "Mais", "Mais", "Raps", "Raps", "Roggen", "Roggen", "Sonnenblume", "Sonnenblume", "Triticale", _

    "Triticale", "Weizen", "Weizen", "Zuckerrübe", "Zuckerrübe", "Zwischenfrucht", "Zwischenfrucht")

    For i = 1 To 50

        Controls("ComboBox_Vorfrucht_" & i).List = arrList

        Controls("ComboBox_Hauptfrucht_" & i).List = arrList

    Next i

Gruß Uwe

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 11:07:55

mumpel

"in den vielen Objektvariablen"
Das sind doch nicht viele. ;) Ich vermute eher, dass das System nicht genug Stapelspeicher zur Verefügung stellt.

AW: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

23.12.2024 11:59:09

Fendt 716

also gibt es keine Möglichkeit dafür. Oder was ist mit dem Stapelspeicher gemeint?

Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

Forumthread: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

Forumthread: Visual Basic Code umschreiben wegen zu wenig Speicher Fehler

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread