Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Datum finden, zwei Zellen daneben auswählen und Bereich ab dort überschreiben
#1
Moin,

ich habe folgendes vor und kenne mich leider noch nicht genug mit VBA aus:

In den Zellen A10:A374 steht das Datum (01.01. bis 31.12.) und in der Zelle zwei danaeben (also Splate C) steht eine Formel, in der ein Wert geändert werden soll.

Ich habe dafür drei Inputboxen:
datebeginn (hier wird das Anfangsdatum eingegeben, als String definiert? oder als Date?)
dateende (hier wird das Enddatum eingegeben, als String definiert? oder als Date?)
datestd (hier wird die Tagesstundenzahl eingegeben, als String definiert? oder als Integer?)

Nun soll das Makro die Zelle mit dem Anfangsdatum in der Spalte A suchen und diesen Wert + 2 Spalten (also von Spalte A auf C) als Range speichern (dafür habe ich Dim beginn As Range), das gleiche dann mit dem Enddatum (Dim ende As Range).

Dann soll die Zelle beginn ausgewählt werden, dort die Formel angepasst werden, der Bereich beginn bis ende ausgewählt und per Selection.Autofill Destinatiion:=Range("&beginn&:&ende&"), Type:=xlFillDefault gefüllt werden.

Die Formel kann glaube ich so ähnlich übernommen werden:
ActiveCell.FormulaR1C1 = "=IF (RC[-2]="""","""",IF(RC[-1]=""X"",0,&datestd&))"

ausgeschrieben würde die Formel in Excel so heißen und in der Spalte C stehen:
=WENN(A10="";"";WENN(B10="X";0;$H$4/5)) -> diesen $H$4/5-Wert würde ich gerne durch datestd ersetzen lassen

Ich hoffe, einer von euch kann meine Gedanken verstehen und mir hierbei helfen. Schon mal vielen Dank für eure Gedanken und Hilfestellungen.

Bis dahin

Gecko
Antworten Top
#2
Ich habe mal ein wenig probiert und komme zumindest etwas weiter, nur schaffe ich die weiteren Schritte nicht:

Ich habe mir erstmal ein Makro gebastelt, dass die eingetragenen Werte der InputBox mit den Werten in der Tabelle abgleicht und mir die Zelle zurück gibt. Diese müsste ich nun verändern (in diesem Fall von Spalte AR auf Spate C), hier aber erstmal mein Anfang, das gleiche kann man dann auch mit dem Enddatum machen:
Code:
Sub Finden ()
Dim rng As Range
Dim sAdress As String
Dim sFind As String
Dim beginn As Range

sFind = Inputbox("Datum:")
sFind = CDate(sFind)

Set rng = Range("AR:AR").Find(What:=CDate(sFind)) 'in AR stehen die Daten im richtigen Vergleichsformat, in A steht das Datum in einem anderen Format
' jetzt müsste rng so verändert werden, dass aus der Spalte AR -> C wird

' nur für Testzwecke, damit man ü+berprüfen kann, ob der rng richtig ist
If Not rng Is Nothing Then
sAdress = rng.Adress
MsgBox (rng.Adress)
Else
MsgBox ("Wert nicht gefunden")
End If
End Sub
Antworten Top
#3
und wieder ein Stück weiter, aber jetzt kommt der Teil mit dem Formeländern und dem neuen Range, hier aber erstmal mein neuer Stand:
Code:
Sub Finden ()
Dim rng As Range
Dim sFind As String
Dim beginn As Range

sFind = Inputbox("Datum:")
sFind = CDate(sFind)

Set rng = Range("AR:AR").Find(What:=CDate(sFind)) ' in AR stehen die Daten im richtigen Vergleichsformat, in A steht das Datum in einem anderen Format
rng.Activate ' jetzt müsste rng so verändert werden, dass aus der Spalte AR -> C wird
ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-41).Activate ' damit steht der Coursor in der richtigen Zelle, jetzt muss die Formel dort angepasst werden

' nur für Testzwecke, damit man überprüfen kann, ob der rng richtig ist
If Not rng Is Nothing Then
MsgBox Selection.Adress
MsgBox Selection.Adress(ReferenceStyle:=xlR1C1) 'für die Formeländerung gedacht
Else
MsgBox ("Wert nicht gefunden")
End If
End Sub
Antworten Top
#4
wieder ein Stück weiter:
Code:
Sub Finden ()

Dim rngbeginn As Range
Dim sFindBeginn As String
Dim beginn As Range
Dim rngende As Range
Dim sFindEnde As String
Dim ende As Range
Dim stdAlt As String

sFindBeginn = InputBox("Anfangsdatum:")
sFindBeginn = CDate(sFindBeginn)
sFindEnde = InputBox("Enddatum:")
sFindEnde = CDate(sFindEnde)
stdAlt = InputBox("alte Tagesstundenzahl:")

Set rngende = Range("AR:AR").Find(What:=CDate(sFindEnde))
rngende.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set ende = Selection.Range.Value 'hier wird der Fehler liegen, hier soll der Range-Wert, der Zelle hinterlegt werden

Set rngbeginn = Range("AR:AR").Find(What:=CDate(sFindBeginn))
rngbeginn.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set beginn = Selection.Range.Value 'hier wird der Fehler liegen, hier soll der Range-Wert, der Zelle hinterlegt werden

ActiveCell.Replace What:="$H$4/5", Replacement:=stdAlt, LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
'Selection.AutoFill Destination:=Range("&beginn&:&ende&"), Type:=xlFillDefault ' hier wird der nächste fehler sein, da ich beginn und ende so nicht in den Range bekomme
Range("A1").Select
End Sub

also einmal nur meine Problemstellen:

Code:
Set ende = Selection.Range.Value 'hier wird der Fehler liegen, hier soll der Range-Wert, der Zelle hinterlegt werden
Code:
Selection.AutoFill Destination:=Range("&beginn&:&ende&"), Type:=xlFillDefault ' hier wird der nächste fehler sein, da ich beginn und ende so nicht in den Range bekomme

Veilleicht kann mir ja irgendwer dabei helfen, sitze jetzt schon den ganzen Tag dran und langsam ist der Kopf voll Sad
Antworten Top
#5
mal wieder etwas weiter:

Code:
Sub Finden()

Dim rngbeginn As Range
Dim sFindBeginn As String
Dim beginn As Range
Dim rngende As Range
Dim sFindEnde As String
Dim ende As Range
Dim stdAlt As String

sFindBeginn = InputBox("Anfangsdatum:")
sFindBeginn = CDate(sFindBeginn)
sFindEnde = InputBox("Enddatum:")
sFindEnde = CDate(sFindEnde)
stdAlt = InputBox("alte Tagesstundenzahl:")

Set rngende = Range("AR:AR").Find(What:=CDate(sFindEnde))
rngende.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set ende = Selection

Set rngbeginn = Range("AR:AR").Find(What:=CDate(sFindBeginn))
rngbeginn.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set beginn = Selection

ActiveCell.Replace What:="$H$4/5", Replacement:=stdAlt, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
Selection.AutoFill Destination:=Range("&beginn&:&ende&"), Type:=xlFillDefault ' hier wird der fehler sein, da ich beginn und ende so nicht in den Range bekomme
Range("A1").Select

End Sub
hier liegt nun die letzte Schwierigkeit:
Code:
Selection.AutoFill Destination:=Range("&beginn&:&ende&"), Type:=xlFillDefault ' hier wird der fehler sein, da ich beginn und ende so nicht in den Range bekomme
Antworten Top
#6
Code:
Sub Finden()

Dim rngbeginn As Range
Dim sFindBeginn As String
Dim beginn As Range
Dim rngende As Range
Dim sFindEnde As String
Dim ende As Range
Dim stdAlt As String
Dim bereich As Range

sFindBeginn = InputBox("Anfangsdatum:")
sFindBeginn = CDate(sFindBeginn)
sFindEnde = InputBox("Enddatum:")
sFindEnde = CDate(sFindEnde)
stdAlt = InputBox("alte Tagesstundenzahl:")

Set rngende = Range("AR:AR").Find(What:=CDate(sFindEnde))
rngende.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set ende = Selection

Set rngbeginn = Range("AR:AR").Find(What:=CDate(sFindBeginn))
rngbeginn.Select
Selection.Offset(rowOffset:=0, ColumnOffset:=-41).Select
Set beginn = Selection

Set bereich = Range(beginn.Address, ende.Address)

ActiveCell.Replace What:="$H$4/5", Replacement:=stdAlt, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
Selection.AutoFill Destination:=Range(bereich.Address), Type:=xlFillDefault
Range("A1").Select

End Sub
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste