Microsoft Excel

Herbers Excel/VBA-Archiv

Datum mit Abfrage

Betrifft: Datum mit Abfrage von: Roman
Geschrieben am: 26.08.2004 07:30:33

Hallo Leute

Habe folgende Aufgabe zu lösen und weiss nicht wie.
Meine File soll aus zwei Tabellenblättern bestehen. In Tabelle1 Soll eine jeden Tag eine Abfrage stattfinden d.h. es soll das aktuelle Datum in einer Zelle angezeigt werden und in der nebenstehenden Zelle soll der User einen Wert eingeben können. In Tabelle2 sollen die o.g. Werte für jeden Tag abgelegt werden  in Spalte A das Datum in B der dazugehörige wert.
Wie löse ich das, habe bereits versucht mit den Funktionen Heute() usw. dort hinzuarbeiten ist jedoch nicht gelungen.

Viele grüsse
Roman

  


Betrifft: AW: Datum mit Abfrage von: Harald E
Geschrieben am: 26.08.2004 08:37:32

Moin Roman,

rechte Maustaste auf Tabelle1 / Code anzeigen / und untenstehende Codes einfügen.
Funktionsweise:
in Tabelle1 Zelle A1 =Heute()
und sobald in b1 der eingegebene Wert mit Enter bestätigt wird, kopiert es dir die gesamte erste Spalte ins Tabellenblatt 2 in die erste freie Zeile (Start in Zeile 2)
....übrigens auch, wenn in Tabelle1 b1 etwas gelöscht wird ;-)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim RaBereich As Range, RaZelle As Range
    Set RaBereich = Range("b1")'dort wird der Wert eingegeben
    For Each RaZelle In Range(Target.Address)
        If Not Intersect(RaZelle, RaBereich) Is Nothing Then Call ZeilenKopieren
    Next RaZelle
    Set RaBereich = Nothing

End Sub


Sub ZeilenKopieren()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Tabelle1")
Set ws2 = ThisWorkbook.Worksheets("Tabelle2")
ws1.Rows(1).Copy ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
End Sub

Ggf. musst Du die Bereiche anpassen.

Gruß
Harald


  


Betrifft: Lass meine Lösung bleiben....funzt nicht. Sorry von: Harald E
Geschrieben am: 26.08.2004 08:52:16

Muss erstmal gucken, warum er die bereits übertragenen Datumswerte aktualisiert

Gruß
Harald


  


Betrifft: AW: Datum mit Abfrage von: Wolfgang
Geschrieben am: 26.08.2004 08:43:38

In Tabelle 1: Kein Problem:
=Heute() in Zelle A1, Bemerkung in Zelle B1

Werte in Tabelle 2 sammeln, da fällt mir spontan nur VBA ein:
Folgende Prozedur im VBA-Projekt der Mappe, Blatt "Tabelle 1" einfügen:
(sie fügt automatisch auf Tabelle 2 unterhalb von A1 und B1 Datum und Wert an, wenn in Tabelle 1 in B1 was eingegeben wird und blendet in Tabelle 2)

Private Sub Worksheet_Change(ByVal Target As Range)
if Target.address = "$B1" then
dateVal=Range("A1").value
textVal=Range("B1").value
Sheets("Tabelle 2").select
if Range("A1").value<>"" then
set theRange=Range("A1").End(xlDown)
set theRange=theRange.Offset(1,0)
else
set theRange=Range("A1")
end if
theRange.value=dateVal
theRange.Offset(0,1).value=textVal
end if
End Sub



  


Betrifft: AW: Datum mit Abfrage von: Roman
Geschrieben am: 26.08.2004 10:55:09

Danke für die Antwort, irgendetwas funkt aber nicht!

Vielleich könnt ihr euch das vorort ansehen

https://www.herber.de/bbs/user/10138.xls

Danke und Gruss
Roman


  


Betrifft: AW: Datum mit Abfrage von: Wolfgang
Geschrieben am: 26.08.2004 14:25:46

Was ist "irgendwas" ?


  


Betrifft: AW: Datum mit Abfrage von: Roman
Geschrieben am: 26.08.2004 15:23:10

Es funzt garnicht, lt. deiner Beschreibung sollte doch in Tabelle 2 unter A1 und B1
die gesammelten Daten (Datum und Bemerkung)angezeigt werden.
Das passiert aber nicht wie du es im upgloadten file siehst https://www.herber.de/bbs/user/10138.xls


  


Betrifft: Weiss da jemand weiter? Wo ist der fehler? von: Roman
Geschrieben am: 27.08.2004 09:59:00


Kann mir da wer weiter helfen?

Viele Grüsse Roman


  


Betrifft: AW: Weiss da jemand weiter? Wo ist der fehler? von: mealone
Geschrieben am: 27.08.2004 17:38:09

hallo roman,

nimm mal den hier

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$1" Then
dateVal = Range("A1").Value
textVal = Range("B1").Value
Worksheets("Tabelle2").Activate
ActiveSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Activate
If ActiveCell.Column = 2 Then
ActiveCell.Offset(1, -1).Value = dateVal
ActiveCell.Offset(1, 0).Value = textVal
Else
ActiveCell.Value = dateVal
ActiveCell.Offset(0, 1).Value = textVal
End If
End If
ActiveSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Activate
Application.ScreenUpdating = True
End Sub



gruss
mealone


 

Beiträge aus den Excel-Beispielen zum Thema "Datum mit Abfrage"