Werte (Uhrzeiten) kopieren/übertragen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Übertragen() Dim letzteZeileQ As Long Dim wsQ As Worksheet ' Quelle Dim wsZ As Worksheet ' Ziel Dim zeileQ As Long Dim zeileZ As Long Set wsQ = ThisWorkbook.Worksheets("Tabelle1") Set wsZ = ThisWorkbook.Worksheets("09.08.2014") letzteZeileQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row For zeileQ = 2 To letzteZeileQ zeileZ = 2 + wsQ.Cells(zeileQ, "A") * 24 wsZ.Cells(zeileZ, "B") = wsQ.Cells(zeileQ, "B") Next zeileQ End Sub

Hi,
vor einer Antwort stellen sich erst mal weitere Fragen.
a) Können die Stundenfolgen von (Tages-)Blatt zu (Tages-)Blatt variieren?
(Dann müsste VBA bei jedem Tag erst mal feststellen, wie der Tag in Zeiten aufgeteilt ist.)
b) Im ersten Beispiel ging es um vollen Stunde, in deinem neuen Beispiel (12:15 - 13:25 - 14:35) beträgt der Abstand
jeweils 70 Minuten. Ist dann das Intervall an diesem Tag immer 70 Minuten oder kann auch das sich ändern?
Was stünde übrigens beim Beispiel (12:15 - 13:25 - 14:35) in A2:A3, was in A24?
c) Oder ist fast gar nichts mehr gleichmäßig? In jedem (Tages-)Blatt könnten auch beliebige Zeiten stehen,
nur nach Größe sortiert sollten sie schon sein.
d) Wie auch immer: Wäre zu prüfen, ob jede der Zeiten in Tabelle1 im (Tages-)Blatt gefunden wird?
Was, wenn sie nicht gefunden wird?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Hallo Urmila,
wenn sich die Zeilennummer nicht mehr aus der Uhrzeit direkt berechnen lässt, dann muss nach ihr gesucht werden. Das könnte z.B. so aussehen:

Sub Übertragen_2()
Dim letzteZeileQ As Long
Dim nichtVorhanden As Boolean
Dim wsQ As Worksheet ' Quelle
Dim wsZ As Worksheet ' Ziel
Dim zeileQ As Long
Dim zeileZ As Long
Set wsQ = ThisWorkbook.Worksheets("Tabelle1")
Set wsZ = ThisWorkbook.Worksheets("09.08.2014")
letzteZeileQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row
For zeileQ = 2 To letzteZeileQ
zeileZ = ZielZeile(wsQ.Cells(zeileQ, "A"), wsZ.Columns("A"), nichtVorhanden)
If nichtVorhanden Then
MsgBox Format$(wsQ.Cells(zeileQ, "A"), "hh:mm") & _
" in Blatt " & wsZ.Name & " nicht vorhanden"
Else
wsZ.Cells(zeileZ, "B") = wsQ.Cells(zeileQ, "B")
End If
Next zeileQ
End Sub
Function ZielZeile(Gesucht As Double, _
Suchbereich As Range, _
NichtGefunden As Boolean) As Long
On Error GoTo Fehler
ZielZeile = Application.WorksheetFunction.Match(Gesucht, Suchbereich, False)
Exit Function
Fehler:
NichtGefunden = True
End Function

Viele Grüße
Dieter

Beliebteste Forumthreads (12 Monate)

Werte (Uhrzeiten) kopieren/übertragen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread