Herbers Excel-Forum - das Archiv
Suchen eines Wertes (mit Makro)
Betrifft: Suchen eines Wertes (mit Makro)
von: pete
Geschrieben am: 12.11.2003 12:14:41
Hallo!
Habe folgendes Problem zu lösen: In einer Tabelle sind in einer Spalte Werte aufsteigend angeordnet. Es soll ein Wert heraus gesucht werden, welcher der Zahl 10 am nächsten kommt. Ist dieser Wert gefunden soll die gesamt Spalte, in der der Wert 10 steht, in ein weiteres Arbeitsblatt übergeben werden.
MfG Pete
Betrifft: Rückfrage
von: ChrisL
Geschrieben am: 12.11.2003 12:17:11
Hi Pete
Und was wenn du einen Wert 9 und einen Wert 11 hast?
Gruss
Chris
Betrifft: AW: Rückfrage
von: Pete
Geschrieben am: 12.11.2003 12:31:47
Ich habe Werte mit 9,xx ; 10,xx ; 11,xx und möchte den Wert haben, der 10,00 am nächsten kommt. Der Suchalgorithmus sollte so sein, dass er nach einer Zahl über 10,00 und unter 10,00 sucht
Bsp:
9,38
9,63
9,88
10,13
10,38
10,64
hier ist also 9,88 die Zahl, die am nächsten der 10,00 kommt. Wenn das gefunden ist soll die Spalte in der 9,88 steht in eine anderes Blatt übergeben werden.
Betrifft: AW: Rückfrage
von: ChrisL
Geschrieben am: 12.11.2003 12:37:19
Hi Pete
Die Frage verstehe ich grundsätzlich schon, was aber wenn du zwei Zahlen mit der gleichen Abweichung hast...
z.B.
9,38
9,63
9,87
10,13
10,38
10,64
Bist du sicher, dass du von Spalten und nicht von Zeilen sprichst?
Gruss
Chris
Betrifft: AW: Rückfrage
von: Pete
Geschrieben am: 12.11.2003 13:23:33
Naja, ich meine natürlich Zeile, wenn natürlich der gleiche Abstand zur 10 ist (unwahrscheinlich)ist der niedrigere Wert (9,xx) zuwählen.
Betrifft: Lösung
von: ChrisL
Geschrieben am: 12.11.2003 15:02:17
Hi Pete
https://www.herber.de/bbs/user/1903.xls
Option Explicit
Sub WertErmitteln()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Richtwert As Currency, Wert As Currency, Abweichung As Currency
Dim iZeile As Long
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
Richtwert = 10
Abweichung = 10000000
For iZeile = 1 To WS1.Range("A65536").End(xlUp).Row
If IsNumeric(WS1.Cells(iZeile, 1)) And WS1.Cells(iZeile, 1) <> "" Then
If Abweichung > Abs(Richtwert - WS1.Cells(iZeile, 1)) Then
Abweichung = Abs(Richtwert - WS1.Cells(iZeile, 1))
Wert = WS1.Cells(iZeile, 1)
End If
End If
Next iZeile
For iZeile = 1 To WS1.Range("A65536").End(xlUp).Row
If WS1.Cells(iZeile, 1) = Wert Then
WS1.Rows(iZeile).Copy WS2.Range("A1")
Exit Sub
End If
Next iZeile
End Sub
Gruss
Chris
Betrifft: AW: Lösung
von: Pete
Geschrieben am: 12.11.2003 15:21:55
Danke für die Tipps und das Pogramm! Werde mal schauen ob das passt!
MfG Pete