Zeile finden und wenn Wert höher überschreiben

Computer: Software & Programmierung Visual Basic
#1

Hi Leute,
brauche mal wieder dringend Hilfe, komme nicht weiter.
Ich muß in einer Tabelle die Startnummer in Spalte A finden,
und dann soll das Ergebnis in Spalte E überschrieben werden,
wenn der Wert höher ist als der vorhandene Wert in der Tabelle.
In Spalte C und D stehen die Namen. Die Tabelle wird automatisch nach Ergebnis (Spalte E) sortiert. In der ersten Zeile steht eine
Überschrift. Die Daten werden immer aus einer UserForm mit
4 TextBoxen in die Tabelle übertragen.
Textbox1 = Startnummer in SpalteA
TextBox2 = Name in SpalteC
TextBox3 = Vorname in SpalteD
Textbox4 = Ergebnis in SpalteE
Im Moment wird immer nur die 2. Zeile kopiert.
Hier der Code im Modul der Userform:

Sub Bedingtes_übertragen()

Dim varZeilennummer As Variant

With Tabelle4

varZeilennummer = Application.Match(.Columns(„A:A“), CInt(Me.TextBox1), 0)

If IsNumeric(varZeilennummer) Then

If CDbl(Me.TextBox4) > CDbl(Tabelle4.Cells(CLng(varZeilennummer), 5)) Then
Tabelle4.Cells(CLng(varZeilennummer), 5) = CDbl(Me.TextBox4)

Else
MsgBox „Keine neue persönliche Bestmarke!“
End If

Else
Call Neuen_Starter_eintragen
End If

End With
Unload Me
End Sub

Sub Neuen_Starter_eintragen()

Dim lngZeile As Long

If Len(Me.TextBox1) * Len(Me.TextBox2) * Len(Me.TextBox3) * Len(Me.TextBox4) > 0 Then
With Tabelle4
lngZeile = Tabelle4.Cells(.Rows.Count, 2).End(xlUp).Row + 1
Tabelle4.Cells(lngZeile, 1).Value = CInt(Me.TextBox1)
Tabelle4.Cells(lngZeile, 3).Value = Me.TextBox2
Tabelle4.Cells(lngZeile, 4).Value = Me.TextBox3
Tabelle4.Cells(lngZeile, 5).Value = CDbl(Me.TextBox4)
End With
Else
MsgBox „Starterdaten fehlen!“
End If

Unload Me
End Sub

Private Sub CommandButton1_Click()
Call Bedingtes_übertragen
End Sub

Private Sub UserForm_Initialize()
Dim Wiederholungen As Integer
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
Call Zellen_ZuOrdnen
End Sub

Sub Zellen_ZuOrdnen()
Dim WS As Worksheet
Set WS = ActiveCell.Parent

For i = 1 To 3
Userform2.controls(„Textbox“ & i).ControlSource = WS.Cells(ActiveCell.Row, i).Address
Next i
End Sub
Bin Einsteiger VBA und habe mir den Code mit Google zusammengestellt
und für meine Tabelle umgeschrieben. Funzt noch nicht richtig.
Wer kann helfen?
Mit bestem Dank im voraus.
Gruß Skaletti!

#2

Hi Skaletti.

Hi Leute,
brauche mal wieder dringend Hilfe, komme nicht weiter.
Ich muß in einer Tabelle die Startnummer in Spalte A finden,
und dann soll das Ergebnis in Spalte E überschrieben werden,
wenn der Wert höher ist als der vorhandene Wert in der
Tabelle.
In Spalte C und D stehen die Namen. Die Tabelle wird
automatisch nach Ergebnis (Spalte E) sortiert. In der ersten
Zeile steht eine
Überschrift. Die Daten werden immer aus einer UserForm mit
4 TextBoxen in die Tabelle übertragen.
Textbox1 = Startnummer in SpalteA
TextBox2 = Name in SpalteC
TextBox3 = Vorname in SpalteD
Textbox4 = Ergebnis in SpalteE
Im Moment wird immer nur die 2. Zeile kopiert.
Hier der Code im Modul der Userform:

Sub Bedingtes_übertragen()

Dim varZeilennummer As Variant

With Tabelle4

varZeilennummer = Application.Match(.Columns(„A:A“),
CInt(Me.TextBox1), 0)

If IsNumeric(varZeilennummer) Then

If CDbl(Me.TextBox4) >
CDbl(Tabelle4.Cells(CLng(varZeilennummer), 5)) Then
Tabelle4.Cells(CLng(varZeilennummer), 5) = CDbl(Me.TextBox4)

Else
MsgBox „Keine neue persönliche Bestmarke!“
End If

Else
Call Neuen_Starter_eintragen
End If

End With
Unload Me
End Sub

Hallo Skaletti.

Ich pflege meine Makros auf eine - für mich - einfachere Art und Weise zu programmieren, daher kann ich dein Makro nicht prüfen - weiß nicht so recht, was da gemacht wird. Mir erscheint jedoch, dass ich dir grundsätzlich helfen kann, möchte vorher jedoch noch einmal nachfragen, was genau gemacht wird:

Du hast Daten über die textboxen eingegeben.
Und dann? Sorry, hab den Ablauf noch nicht so herausgelesen. Kannst du mir den noch einmal Schritt für Schritt erläutern, dann kann ich gerne versuchen, dir ein funktionieren code zu schreiben.

Grüße, Aiko.

#3

Hallo Skaletti.

Ich habe eine frühere Anfrage von dir gefunden, die ähnlich zu deiner jetzigen Frage ist. Sollten beide Fragen das gleiche Problem betreffen, dann habe ich evtl. eine mögliche Lösung:

Sub neues_ergebnis()

Dim startnummer As String
startnummer = InputBox(„Bitte Startnummer eingeben“)
Dim name As String
name = InputBox(„Bitte Name eingeben“)
Dim vorname As String
vorname = InputBox(„Bitte Vorname eingeben“)
Dim ergebnis As String
ergebnis = InputBox(„Bitte aktuelles Ergbenis eingeben“)

'Prüfung, ob startnummer existiert

Dim startnummer_zelle As String
i = 2
Do Until Range(„B“ & i) = „“
Range(„B“ & i).Select
startnummer_zelle = ActiveCell
If startnummer_zelle = startnummer Then GoTo eintragen
i = i + 1
Loop

If startwert „1“ Then
Range(„B“ & i).Select
ActiveCell = startnummer
ActiveCell.Offset(0, 1).Select
ActiveCell = name
ActiveCell.Offset(0, 1).Select
ActiveCell = vorname
ActiveCell.Offset(0, 1).Select
ActiveCell = ergebnis
Else
End If

eintragen:
'suchen nach startnummer und evtl übertragen des neuen Ergebnisses
i = 2
Do Until Range(„B“ & i) = startnummer
i = i + 1
Loop

Dim ergebnis_alt As String
ergebnis_alt = Range(„E“ & i)
If ergebnis > ergebnis_alt Then
Range(„E“ & i) = ergebnis
Else
End If

ende:
Range(„A2“).Select

End Sub

Was das Makro macht:

  1. zuerst werden Startnummer, Name, Vorname und aktuelles Ergebnis mittels Abfrage eingelesen/eingetippt.
  2. Es wird in einer Schleife geschaut, ob die eingegebene Startnummer schon in der Liste ist ( bei mir steht die Startnummer in Spalte B). Wenn die Startnummer gefunden wird, dann schau bei Punkt 3a) weiter.
  3. An die letzte Zeile werden die neuen Daten eingegeben und das Makro beendet.
    3a. In einer Schleife wird die schon vergebene Startnummer erneut gesucht und anschließend das alte Ergebnis mit dem neuen Ergebnis verglichen. Ist das neue Ergebnis größer als das alte Ergenis (hab es mit einer reinen Zahl probiert), dann wird das alte Ergebnis überschrieben (bei mir stehen die Ergebnisse jeweils in Spalte E) und das Makro ist zu Ende.

War es das, was du brauchtest? Bei Fragen, kannst du dich gerne bei mir melden oder schreiben. Das Makro ließe sich sicher noch etwas verkürzen, wenn man die Schleifen in einander bastelt - hab ich aber beim schreiben/testen erst später bemerkt.

Grüße, Aiko.

#4

Hi Aiko,
Viele, Vielen dank für Deine Hilfe.
Ohne Dein Makro hätte ich die Sache nie hingekriegt.
Beide Anfragen waren zum gleichen Thema.
Du hast richtig verstanden wie die Sache funktionieren sollte.
Läuft alles wie geplant.
Habe die Sache etwas verkürzt.
War gar nicht so einfach für einen Anfänger, hat aber geklappt.
(Mit etwas Hilfe im Internet)
Die „Match-Funktion“ die ich in meinem Makro hatte funktionierte
wohl nicht.
Nochmals vielen Dank.

Gruß Skaletti!

Fals es Dich interessier, hier das jetzige Makro:

Sub Bedingtes_übertragen()
With Tabelle4
i = 2
Do While .Range(„A“ & i) „“
If CInt(.Range(„A“ & i)) = CInt(Me.TextBox1) Then
If CDbl(Me.TextBox4) > CDbl(.Range(„E“ & i)) Then

.Range(„E“ & i) = CDbl(Me.TextBox4)
End If
Exit Sub
End If

i = i + 1
Loop

Call Neuen_Starter_eintragen

End With
End Sub

Sub Neuen_Starter_eintragen()

Dim lngZeile As Long

If Len(Me.TextBox1) * Len(Me.TextBox2) * Len(Me.TextBox3) * Len(Me.TextBox4) > 0 Then
With Tabelle4
lngZeile = Tabelle4.Cells(.Rows.Count, 1).End(xlUp).Row + 1
Tabelle4.Cells(lngZeile, 1).Value = CInt(Me.TextBox1)
Tabelle4.Cells(lngZeile, 3).Value = Me.TextBox2
Tabelle4.Cells(lngZeile, 4).Value = Me.TextBox3
Tabelle4.Cells(lngZeile, 5).Value = CDbl(Me.TextBox4)
End With
Else
MsgBox „Starterdaten fehlen!“
End If

End Sub