Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
176to180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
176to180
176to180
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zwei Suchvariablen in VBA einbinden

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, 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'

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, 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'


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, 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'

End If


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

End Sub


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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

Anzeige

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige