ja sorry aber ich hatte schon mal gepostet..aber nochmal hier der code:
Sub Datensatz_übernehmen()
Dim suchVariable, 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
suchVariable = Sheets("Gewässermorphologische Grundlag").Cells(8, 3).Value 'Kennung'
Wert1 = Sheets("Gewässermorphologische Grundlag").Cells(8, 14).Value 'Gewässerabschnitt'
Wert2 = Sheets("Gewässermorphologische Grundlag").Cells(7, 30).Value 'Taltyp'
Wert3 = Sheets("Gewässermorphologische Grundlag").Cells(9, 34).Value 'Krümmungstyp'
Wert4 = Sheets("Gewässermorphologische Grundlag").Cells(14, 22).Value 'Lauftyp'
Wert5 = Sheets("Gewässermorphologische Grundlag").Cells(14, 30).Value 'Gewässergröße'
Wert6 = Sheets("Gewässermorphologische Grundlag").Cells(13, 33).Value 'Regimetyp'
Wert7 = Sheets("Gewässermorphologische Grundlag").Cells(19, 33).Value 'Gewässerlandschaft'
Wert8 = Sheets("Bewertung Gewässerbettdynamik").Cells(11, 7).Value 'Linienführung'
Wert9 = Sheets("Bewertung Gewässerbettdynamik").Cells(9, 13).Value 'Uferverbau'
Wert10 = Sheets("Bewertung Gewässerbettdynamik").Cells(29, 6).Value 'Querbauwerke'
Wert11 = Sheets("Bewertung Gewässerbettdynamik").Cells(28, 13).Value 'Abflußregelung'
Wert12 = Sheets("Bewertung Gewässerbettdynamik").Cells(36, 6).Value 'Uferbewuchs'
Wert13 = Sheets("Bewertung Gewässerbettdynamik").Cells(33, 13).Value 'Tiefenerosion'
Wert14 = Sheets("Bewertung Auedynamik").Cells(8, 5).Value 'Hochwasserschutzbauwerke'
Wert15 = Sheets("Bewertung Auedynamik").Cells(8, 13).Value 'Ausuferungsvermögen'
Wert16 = Sheets("Bewertung Auedynamik").Cells(17, 18).Value 'Auenutzung'
Wert17 = Sheets("Bewertung Auedynamik").Cells(16, 6).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, 13).Value 'Retention'
Wert22 = Sheets("Bewertung Auedynamik").Cells(18, 18).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 = Range("A4").End(xlDown).Row
a = 0
For x = 1 To i
If ActiveSheet.Cells(x, 1).Value = suchVariable Then 'Kennung'
ActiveSheet.Cells(x, 2).Value = Wert1 'Gewässerabschnitt'
ActiveSheet.Cells(x, 6).Value = Wert2 'Taltyp'
ActiveSheet.Cells(x, 7).Value = Wert3 'Krümmungstyp'
ActiveSheet.Cells(x, 8).Value = Wert4 'Lauftyp'
ActiveSheet.Cells(x, 9).Value = Wert5 'Gewässergröße'
ActiveSheet.Cells(x, 10).Value = Wert6 'Regimetyp'
ActiveSheet.Cells(x, 11).Value = Wert7 'Gewässerlandschaft'
ActiveSheet.Cells(x, 12).Value = Wert8 'Linienführung'
ActiveSheet.Cells(x, 13).Value = Wert9 'Uferverbau'
ActiveSheet.Cells(x, 14).Value = Wert10 'Querbauwerke'
ActiveSheet.Cells(x, 15).Value = Wert11 'Abflußregelung'
ActiveSheet.Cells(x, 16).Value = Wert12 'Uferbewuchs'
ActiveSheet.Cells(x, 17).Value = Wert13 'Tiefenerosion'
ActiveSheet.Cells(x, 18).Value = Wert14 'Hochwasserschutzbauwerke'
ActiveSheet.Cells(x, 19).Value = Wert15 'Ausuferungsvermögen'
ActiveSheet.Cells(x, 20).Value = Wert16 'Auenutzung'
ActiveSheet.Cells(x, 21).Value = Wert17 'Uferstreifen'
ActiveSheet.Cells(x, 22).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 23).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 24).Value = Wert20 'Uferbewuchs'
ActiveSheet.Cells(x, 25).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 26).Value = Wert22 'Entwicklungspotential'
ActiveSheet.Cells(x, 27).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 28).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 29).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")
ActiveSheet.Cells(x, 1).Value = suchVariable 'Kennung'
ActiveSheet.Cells(x, 2).Value = Wert1 'Gewässerabschnitt'
ActiveSheet.Cells(x, 6).Value = Wert2 'Taltyp'
ActiveSheet.Cells(x, 7).Value = Wert3 'Krümmungstyp'
ActiveSheet.Cells(x, 8).Value = Wert4 'Lauftyp'
ActiveSheet.Cells(x, 9).Value = Wert5 'Gewässergröße'
ActiveSheet.Cells(x, 10).Value = Wert6 'Regimetyp'
ActiveSheet.Cells(x, 11).Value = Wert7 'Gewässerlandschaft'
ActiveSheet.Cells(x, 12).Value = Wert8 'Linienführung'
ActiveSheet.Cells(x, 13).Value = Wert9 'Uferverbau'
ActiveSheet.Cells(x, 14).Value = Wert10 'Querbauwerke'
ActiveSheet.Cells(x, 15).Value = Wert11 'Abflußregelung'
ActiveSheet.Cells(x, 16).Value = Wert12 'Uferbewuchs'
ActiveSheet.Cells(x, 17).Value = Wert13 'Tiefenerosion'
ActiveSheet.Cells(x, 18).Value = Wert14 'Hochwasserschutzbauwerke'
ActiveSheet.Cells(x, 19).Value = Wert15 'Ausuferungsvermögen'
ActiveSheet.Cells(x, 20).Value = Wert16 'Auenutzung'
ActiveSheet.Cells(x, 21).Value = Wert17 'Uferstreifen'
ActiveSheet.Cells(x, 22).Value = Wert18 'Linienführung'
ActiveSheet.Cells(x, 23).Value = Wert19 'Strukturbildungsvermögen'
ActiveSheet.Cells(x, 24).Value = Wert20 'Uferbewuchs'
ActiveSheet.Cells(x, 25).Value = Wert21 'Retention'
ActiveSheet.Cells(x, 26).Value = Wert22 'Entwicklungspotential'
ActiveSheet.Cells(x, 27).Value = Wert23 'Gewässerbettdynamik'
ActiveSheet.Cells(x, 28).Value = Wert24 'Auedynamik'
ActiveSheet.Cells(x, 29).Value = Wert25 'Strukturgüteklasse'
End If
End Sub
es ist ein ziemliches monster, aber es funktioniert, wie gesagt bis darauf, dass alle kennummern, die in "Datensätze" (Tabellenblatt) unter "1.22" stehen nicht gefunden werden.
Das Problem ist denke ich, der Aufbau der Kennummern von 1.22 bis 1.22.5 bis 1.22.10.1 usw.
Thomas D.