Herbers Excel-Forum - das Archiv
Werte suchen und übertragen
- Werte suchen und übertragen von toni vom 20.11.2003 10:11:34
- AW: Werte suchen und übertragen - von Klaus Schubert am 20.11.2003 17:33:19
- AW: Werte suchen und übertragen - von toni am 20.11.2003 18:05:46
- AW: Werte suchen und übertragen - von toni am 20.11.2003 18:05:46
- AW: Werte suchen und übertragen - von Klaus Schubert am 20.11.2003 17:33:19
 |
Betrifft: Werte suchen und übertragen
von: toni
Geschrieben am: 20.11.2003 10:11:34
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?
 |
Betrifft: AW: Werte suchen und übertragen
von: Klaus Schubert
Geschrieben am: 20.11.2003 17:33:19
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
|
Betrifft: AW: Werte suchen und übertragen
von: toni
Geschrieben am: 20.11.2003 18:05:46
Hallo Klaus,
vielen Dank für Deine Hilfe.
Probiere den Code gleich morgen früh aus.
Mache jetzt Feierabend
Ciao
Toni
| |