Sub Datensatz_übernehmen()
Dim suchVariabel, a
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
suchVariabel = Sheets("Geomorphologische Grundlag").Cells(8, 3).Formula 'Kennung'
Wert1 = Sheets("Geomorphologische Grundlag").Cells(8, 14).Formula 'Gewässerabschnitt'
Wert2 = Sheets("Geomorphologische Grundlag").Cells(7, 30).Formula 'Taltyp'
Wert3 = Sheets("Geomorphologische Grundlag").Cells(9, 34).Formula 'Krümmungstyp'
Wert4 = Sheets("Geomorphologische Grundlag").Cells(14, 22).Formula 'Lauftyp'
Wert5 = Sheets("Geomorphologische Grundlag").Cells(14, 30).Formula 'Gewässergröße'
Wert6 = Sheets("Geomorphologische Grundlag").Cells(13, 33).Formula 'Regimetyp'
Wert7 = Sheets("Geomorphologische Grundlag").Cells(19, 33).Formula 'Gewässerlandschaft'
Wert8 = Sheets("Bewertung Gewässerbettdynamik").Cells(11, 7).Formula 'Linienführung'
Wert9 = Sheets("Bewertung Gewässerbettdynamik").Cells(9, 13).Formula 'Uferverbau'
Wert10 = Sheets("Bewertung Gewässerbettdynamik").Cells(29, 6).Formula 'Querbauwerke'
Wert11 = Sheets("Bewertung Gewässerbettdynamik").Cells(28, 13).Formula 'Abflußregelung'
Wert12 = Sheets("Bewertung Gewässerbettdynamik").Cells(36, 6).Formula 'Uferbewuchs'
Wert13 = Sheets("Bewertung Gewässerbettdynamik").Cells(33, 13).Formula 'Tiefenerosion'
Wert14 = Sheets("Bewertung Auedynamik").Cells(8, 5).Formula 'Hochwasserschutzbauwerke'
Wert15 = Sheets("Bewertung Auedynamik").Cells(8, 13).Formula 'Ausuferungsvermögen'
Wert16 = Sheets("Bewertung Auedynamik").Cells(17, 18).Formula 'Auenutzung'
Wert17 = Sheets("Bewertung Auedynamik").Cells(16, 6).Formula 'Uferstreifen'
Wert18 = Sheets("Bewertung Gewässerbettdynamik").Cells(11, 7).Formula 'Linienführung'
Wert19 = Sheets("Bewertung Gewässerbettdynamik").Cells(30, 6).Formula 'Strukturbildungsvermögen'
Wert20 = Sheets("Bewertung Gewässerbettdynamik").Cells(36, 6).Formula 'Uferbewuchs'
Wert21 = Sheets("Bewertung Auedynamik").Cells(9, 13).Formula 'Retention'
Wert22 = Sheets("Bewertung Auedynamik").Cells(18, 18).Formula 'Entwicklungspotential'
Wert23 = Sheets("Gesamtbewertung ").Cells(8, 5).Formula 'Gewässerbettdynamik'
Wert24 = Sheets("Gesamtbewertung ").Cells(8, 14).Formula 'Auedynamik'
Wert25 = Sheets("Gesamtbewertung ").Cells(12, 29).Formula 'Strukturgüteklasse'
Sheets("Datensätze").Select
i = Range("A1").End(xlDown).Row
a = 0
For x = 1 To i
If ActiveSheet.Cells(x, 1).Formula = suchVariabel Then 'Kennung'
ActiveSheet.Cells(x, 2).Formula = Wert1 'Gewässerabschnitt'
ActiveSheet.Cells(x, 6).Formula = Wert2 'Taltyp'
ActiveSheet.Cells(x, 7).Formula = Wert3 'Krümmungstyp'
ActiveSheet.Cells(x, 8).Formula = Wert4 'Lauftyp'
ActiveSheet.Cells(x, 9).Formula = Wert5 'Gewässergröße'
ActiveSheet.Cells(x, 10).Formula = Wert6 'Regimetyp'
ActiveSheet.Cells(x, 11).Formula = Wert7 'Gewässerlandschaft'
ActiveSheet.Cells(x, 12).Formula = Wert8 'Linienführung'
ActiveSheet.Cells(x, 13).Formula = Wert9 'Uferverbau'
ActiveSheet.Cells(x, 14).Formula = Wert10 'Querbauwerke'
ActiveSheet.Cells(x, 15).Formula = Wert11 'Abflußregelung'
ActiveSheet.Cells(x, 16).Formula = Wert12 'Uferbewuchs'
ActiveSheet.Cells(x, 17).Formula = Wert13 'Tiefenerosion'
ActiveSheet.Cells(x, 18).Formula = Wert14 'Hochwasserschutzbauwerke'
ActiveSheet.Cells(x, 19).Formula = Wert15 'Ausuferungsvermögen'
ActiveSheet.Cells(x, 20).Formula = Wert16 'Auenutzung'
ActiveSheet.Cells(x, 21).Formula = Wert17 'Uferstreifen'
ActiveSheet.Cells(x, 22).Formula = Wert18 'Linienführung'
ActiveSheet.Cells(x, 23).Formula = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 24).Formula = Wert20 'Uferbewuchs'
ActiveSheet.Cells(x, 25).Formula = Wert21 'Retention'
ActiveSheet.Cells(x, 26).Formula = Wert22 'Entwicklungspotential'
ActiveSheet.Cells(x, 27).Formula = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 28).Formula = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 29).Formula = 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")
ActiveSheet.Cells(x, 1).Formula = suchVariabel 'Kennung'
ActiveSheet.Cells(x, 2).Formula = Wert1 'Gewässerabschnitt'
ActiveSheet.Cells(x, 6).Formula = Wert2 'Taltyp'
ActiveSheet.Cells(x, 7).Formula = Wert3 'Krümmungstyp'
ActiveSheet.Cells(x, 8).Formula = Wert4 'Lauftyp'
ActiveSheet.Cells(x, 9).Formula = Wert5 'Gewässergröße'
ActiveSheet.Cells(x, 10).Formula = Wert6 'Regimetyp'
ActiveSheet.Cells(x, 11).Formula = Wert7 'Gewässerlandschaft'
ActiveSheet.Cells(x, 12).Formula = Wert8 'Linienführung'
ActiveSheet.Cells(x, 13).Formula = Wert9 'Uferverbau'
ActiveSheet.Cells(x, 14).Formula = Wert10 'Querbauwerke'
ActiveSheet.Cells(x, 15).Formula = Wert11 'Abflußregelung'
ActiveSheet.Cells(x, 16).Formula = Wert12 'Uferbewuchs'
ActiveSheet.Cells(x, 17).Formula = Wert13 'Tiefenerosion'
ActiveSheet.Cells(x, 18).Formula = Wert14 'Hochwasserschutzbauwerke'
ActiveSheet.Cells(x, 19).Formula = Wert15 'Ausuferungsvermögen'
ActiveSheet.Cells(x, 20).Formula = Wert16 'Auenutzung'
ActiveSheet.Cells(x, 21).Formula = Wert17 'Uferstreifen'
ActiveSheet.Cells(x, 22).Formula = Wert18 'Linienführung'
ActiveSheet.Cells(x, 23).Formula = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 24).Formula = Wert20 'Uferbewuchs'
ActiveSheet.Cells(x, 25).Formula = Wert21 'Retention'
ActiveSheet.Cells(x, 26).Formula = Wert22 'Entwicklungspotential'
ActiveSheet.Cells(x, 27).Formula = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 28).Formula = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 29).Formula = Wert25 'Strukturgüteklasse'
End If
End Sub
Fehlermeldung: Laufzeitfehler 9, Index außerhalk des gültigen Bereichs.
zaskar