Zwei Suchvariablen in VBA einbinden

Forumthread: Zwei Suchvariablen in VBA einbinden

05.11.2002 17:15:25

Thomas D.

Hallo

ich möchte aus einem Formular Daten in ein Tabellenblatt (Zusammenfassung)übetragen.

Das ganze funktioniert mit einer Suchfunktion:

Das heißt
als Zellwerte die einen Datensatz von weiteren unterscheiden werden zwei Werte eingegeben (Kennung und Abschnitt).
Diese Werte werden auf dem Tabellenblatt (Zusammenfassung) gesucht und die anderen zugehörigen Daten dahinter auf die Spalten verteilt.

Ich hatte das ganze schon für eine Suchvariable, was auch super funktioniert hat, nur als die zweite mit rein sollte läuft es nicht.

Wer kann helfen:

Hier mein monströser code:

Sub Datensatz_übernehmen()
Worksheets("Datensätze").Unprotect "gms"
Dim suchVariable, a
Dim suchVariab, b
Dim Wert1, Wert2, Wert3, Wert4, Wert5, Wert6, Wert7, Wert8, Wert9, Wert10, Wert11, Wert12, Wert13, Wert14, Wert15, Wert16, Wert17, Wert18, Wert19, Wert20, Wert21, Wert22, Wert23, Wert24, Wert25

suchVariable = Sheets("Gewässermorphologische Grundlag").Cells(8, 4).Value And suchVariab = Sheets("Gewässermorphologische Grundlag").Cells(8, 15).Value
'Kennung und Gewässerabschnitt'

Wert1 = Sheets("Gewässermorphologische Grundlag").Cells(14, 4).Value 'Teileinzugsgebiet'
Wert2 = Sheets("Gewässermorphologische Grundlag").Cells(7, 31).Value 'Taltyp'
Wert3 = Sheets("Gewässermorphologische Grundlag").Cells(9, 35).Value 'Krümmungstyp'
Wert4 = Sheets("Gewässermorphologische Grundlag").Cells(14, 23).Value 'Lauftyp'
Wert5 = Sheets("Gewässermorphologische Grundlag").Cells(14, 31).Value 'Gewässergröße'
Wert6 = Sheets("Gewässermorphologische Grundlag").Cells(13, 34).Value 'Regimetyp'
Wert7 = Sheets("Gewässermorphologische Grundlag").Cells(19, 34).Value 'Gewässerlandschaft'

Wert8 = Sheets("Bewertung Gewässerbettdynamik").Cells(11, 7).Value 'Linienführung'
Wert9 = Sheets("Bewertung Gewässerbettdynamik").Cells(9, 14).Value 'Uferverbau'
Wert10 = Sheets("Bewertung Gewässerbettdynamik").Cells(29, 6).Value 'Querbauwerke'
Wert11 = Sheets("Bewertung Gewässerbettdynamik").Cells(28, 14).Value 'Abflußregelung'
Wert12 = Sheets("Bewertung Gewässerbettdynamik").Cells(36, 6).Value 'Uferbewuchs'
Wert13 = Sheets("Bewertung Gewässerbettdynamik").Cells(33, 14).Value 'Tiefenerosion'

Wert14 = Sheets("Bewertung Auedynamik").Cells(8, 6).Value 'Hochwasserschutzbauwerke'
Wert15 = Sheets("Bewertung Auedynamik").Cells(8, 16).Value 'Ausuferungsvermögen'
Wert16 = Sheets("Bewertung Auedynamik").Cells(17, 21).Value 'Auenutzung'
Wert17 = Sheets("Bewertung Auedynamik").Cells(16, 7).Value 'Uferstreifen'

Wert18 = Sheets("Bewertung Gewässerbettdynamik").Cells(11, 7).Value 'Linienführung'
Wert19 = Sheets("Bewertung Gewässerbettdynamik").Cells(30, 6).Value 'Strukturbildungsvermögen'
Wert20 = Sheets("Bewertung Gewässerbettdynamik").Cells(36, 6).Value 'Uferbewuchs'

Wert21 = Sheets("Bewertung Auedynamik").Cells(9, 16).Value 'Retention'
Wert22 = Sheets("Bewertung Auedynamik").Cells(18, 21).Value 'Entwicklungspotential'

Wert23 = Sheets("Gesamtbewertung").Cells(8, 5).Value 'Gewässerbettdynamik'
Wert24 = Sheets("Gesamtbewertung").Cells(8, 14).Value 'Auedynamik'
Wert25 = Sheets("Gesamtbewertung").Cells(12, 29).Value 'Strukturgüteklasse'

Sheets("Datensätze").Select
i = ActiveSheet.UsedRange.Rows.Count

a = 0
For x = 1 To i
If ActiveSheet.Cells(x, 1).Value = suchVariable And ActiveSheet.Cells(x, 2).Value = suchVariab Then 'Kennung und Abschnittsnummer'

ActiveSheet.Cells(x, 4).Value = Wert1 'Teileinzugsgebiet'
ActiveSheet.Cells(x, 7).Value = Wert2 'Taltyp'
ActiveSheet.Cells(x, 8).Value = Wert3 'Krümmungstyp'
ActiveSheet.Cells(x, 9).Value = Wert4 'Lauftyp'
ActiveSheet.Cells(x, 10).Value = Wert5 'Gewässergröße'
ActiveSheet.Cells(x, 11).Value = Wert6 'Regimetyp'
ActiveSheet.Cells(x, 12).Value = Wert7 'Gewässerlandschaft'

ActiveSheet.Cells(x, 13).Value = Wert8 'Linienführung'
ActiveSheet.Cells(x, 14).Value = Wert9 'Uferverbau'
ActiveSheet.Cells(x, 15).Value = Wert10 'Querbauwerke'
ActiveSheet.Cells(x, 16).Value = Wert11 'Abflußregelung'
ActiveSheet.Cells(x, 17).Value = Wert12 'Uferbewuchs'
ActiveSheet.Cells(x, 18).Value = Wert13 'Tiefenerosion'

ActiveSheet.Cells(x, 19).Value = Wert14 'Hochwasserschutzbauwerke'
ActiveSheet.Cells(x, 20).Value = Wert15 'Ausuferungsvermögen'
ActiveSheet.Cells(x, 21).Value = Wert16 'Auenutzung'
ActiveSheet.Cells(x, 22).Value = Wert17 'Uferstreifen'

ActiveSheet.Cells(x, 23).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 24).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 25).Value = Wert20 'Uferbewuchs'

ActiveSheet.Cells(x, 26).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 27).Value = Wert22 'Entwicklungspotential'

ActiveSheet.Cells(x, 28).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 29).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 30).Value = Wert25 'Strukturgüteklasse'

a = a + 1
End If

Next x
If a = 0 Then
MsgBox ("Es wurde keine Eintrag mit dieser Kennnummer gefunden. Neuer Eintrag wurde eröffnet")
End If
If ActiveSheet.Cells(x, 1).Value = suchVariable And ActiveSheet.Cells(x, 2).Value = suchVariab Then 'Kennung und Abschnittsnummer'

ActiveSheet.Cells(x, 23).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 24).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 25).Value = Wert20 'Uferbewuchs'

ActiveSheet.Cells(x, 26).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 27).Value = Wert22 'Entwicklungspotential'

ActiveSheet.Cells(x, 28).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 29).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 30).Value = Wert25 'Strukturgüteklasse'

End If

b = 0
For x = 1 To i
If ActiveSheet.Cells(x, 1).Value = suchVariable And ActiveSheet.Cells(x, 2).Value = suchVariab Then 'Kennung und Abschnittsnummer'

ActiveSheet.Cells(x, 23).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 24).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 25).Value = Wert20 'Uferbewuchs'

ActiveSheet.Cells(x, 26).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 27).Value = Wert22 'Entwicklungspotential'

ActiveSheet.Cells(x, 28).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 29).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 30).Value = Wert25 'Strukturgüteklasse'

b = b + 1
End If

Next x
If b = 0 Then
MsgBox ("Es wurde keine Eintrag mit dieser Kennnummer gefunden. Neuer Eintrag wurde eröffnet")
End If
If ActiveSheet.Cells(x, 1).Value = suchVariable And ActiveSheet.Cells(x, 2).Value = suchVariab Then 'Kennung und Abschnittsnummer'

ActiveSheet.Cells(x, 23).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 24).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 25).Value = Wert20 'Uferbewuchs'

ActiveSheet.Cells(x, 26).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 27).Value = Wert22 'Entwicklungspotential'

ActiveSheet.Cells(x, 28).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 29).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 30).Value = Wert25 'Strukturgüteklasse'

End If

Worksheets("Datensätze").Protect "gms"

End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Re: Zwei Suchvariablen in VBA einbinden

06.11.2002 07:35:41

Hans W. Herber

Re: Zwei Suchvariablen in VBA einbinden

06.11.2002 07:35:41

Hans W. Herber

Hallo Thomas,

zur Frage selbst: Das mit der AND-Verbindung bei der Variablenzuweisung funktioniert nicht, weise einzeln zu.

Tu Dir bitte den Gefallen und sieh Dir in der neugeschaffenen Excel-FAQ den Abschnitt xlBasics an.
Du findest dort Hinweise zur Deklaration der Variablen (bei Dir fehlt die Dimensionierung), zur Handhabung von Objekt-Variablen und dem Einsatz von With-Rahmen (Du wiederholst ständig die gleichen Referenzierungen), dem Einsatz von Feldvariablen (Du verwendest eigene Variablen für Serien).

hans

Beliebteste Forumthreads (12 Monate)

Zwei Suchvariablen in VBA einbinden

Forumthread: Zwei Suchvariablen in VBA einbinden

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread