Werte suchen und übertragen

Forumthread: Werte suchen und übertragen

20.11.2003 10:11:34

toni

Hallo VBA'ler,

vielleicht kann mir jemand bei folgendem Problem helfen:

1. Ich habe ein Sheet (Basiswerte), das folgendes Aussehen hat (die Zahlen sind irgendwelche Basiswerte):

Tierart_Bas1__Bas2__Bas3
Hund____200___350___445
Katze____345___420___599
Maus____444__ 588___600
...usw.

2. Ich habe ein weiteres Sheet (Eingabe), in dem Eingaben gemacht werden:

Tierart Gewicht Ergebnis(Basiswert x Gewicht)
Hund________23_______(leer)
Maus________0,4______(leer)

3. Nun möchte ich folgendes erreichen:

Beim Klick in die leere Zelle(z.B. Zeile1) 'Ergebnis' soll folgendes passieren:
- Im Sheet Basiswerte soll nach dem Eintrag 'Hund' gesucht werden.
- Die entsprechenden Basiswerte sollen nun in ein drittes Sheet (Rechnen) gestellt werden und zwar in folgender Form:

Basiswert__Gewicht__Ergebnis(Basiswert x Gewicht)
200_________23_________4600
350_________23_________8050 ... hier wird später weitergerechnet
445_________23_________10235

Das ganze ist für mich zu komplex. Es wäre schon Klasse, wenn mir jemand helfen könnte.

Gruss Toni

P.S. Beachtet der Editor nicht mehrere Leerzeichen oder Tabs?

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Werte suchen und übertragen

20.11.2003 17:33:19

Klaus Schubert
AW: Werte suchen und übertragen

20.11.2003 18:05:46

toni

AW: Werte suchen und übertragen

20.11.2003 17:33:19

Klaus Schubert

Hallo Toni,

mit Alt+F11 in die VBA-Umgebung wechseln, links oben im Projektfenster die Tabelle "Eingabe" doppelklicken und dann im rechten Codefenster diesen Code: (Dieser Code funktioniert aber nur, wenn deine Daten jeweils in Spalte A anfangen !!!)


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Suchbegriff As String, Trefferzelle As Range, i As Integer
Application.ScreenUpdating = False
If Target.Column = 3 And Target.Row <> 1 Then
Suchbegriff = Cells(Target.Row, 1)
With Sheets("Basiswerte")
.Activate
Set Trefferzelle = .Columns(1).Find(What:=Suchbegriff, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
Sheets("Ergebnis").Range("a2:b4").ClearContents
For i = 2 To 4
.Cells(Trefferzelle.Row, i).Copy Sheets("Ergebnis").Cells(i, 1)
Cells(Target.Row, 2).Copy Sheets("Ergebnis").Cells(i, 2)
Next i
End With
Sheets("Ergebnis").Activate
End If
Application.ScreenUpdating = False
End Sub

Oder die Beispieldatei studieren: https://www.herber.de/bbs/user/2050.xls

Bitte die Datei abspeichern und dann öffnen, in meinem Browserfenster funktionierte das direkte Öffnen nicht richtig !

Gruß Klaus

AW: Werte suchen und übertragen

20.11.2003 18:05:46

toni

Hallo Klaus,

vielen Dank für Deine Hilfe.
Probiere den Code gleich morgen früh aus.
Mache jetzt Feierabend

Ciao

Toni

Beliebteste Forumthreads (12 Monate)

Forumthread: Werte suchen und übertragen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread