Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
472to476
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datum mit Abfrage

Datum mit Abfrage
26.08.2004 07:30:33
Roman
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datum mit Abfrage
26.08.2004 08:37:32
Harald
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
Anzeige
Lass meine Lösung bleiben....funzt nicht. Sorry
26.08.2004 08:52:16
Harald
Muss erstmal gucken, warum er die bereits übertragenen Datumswerte aktualisiert
Gruß
Harald
AW: Datum mit Abfrage
26.08.2004 08:43:38
Wolfgang
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

Anzeige
AW: Datum mit Abfrage
26.08.2004 10:55:09
Roman
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
AW: Datum mit Abfrage
26.08.2004 14:25:46
Wolfgang
Was ist "irgendwas" ?
AW: Datum mit Abfrage
26.08.2004 15:23:10
Roman
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
Weiss da jemand weiter? Wo ist der fehler?
27.08.2004 09:59:00
Roman
Kann mir da wer weiter helfen?
Viele Grüsse Roman
Anzeige
AW: Weiss da jemand weiter? Wo ist der fehler?
mealone
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige