VBA Until Loop

Hey in die Runde,
Ich habe ein sehr einfaches Problem (glaube ich) finde aber einfach keine Lösung, darum versuche ich es jetzt hier. Bisher habe ich mich immer durchgeschlagen, aber jetzt ist es vorbei.
Mein Ziel ist es Werte aus einer Tabelle in eine andere zu kopieren, wenn sie das gleiche Datum und Zeit haben. Das Datum und Zeit steht in Spalte A, die Werte in B. Bei Datum & Zeit handelt es sich um halbstüundliche Werte über ein halbes bzw. ganzes Jahr auf zwei Tabellen aufgeteilt.
Die zwei Tabellen befinden sich auf verschieden Sheets. Ich habe versucht eine Until Schleife zu starten und hätte dann versucht den gefundenen Wert zu kopieren.
Bei der Until Schleife bekomme ich einen Runtimeerror und für die Kopiervariante habe ich keine Idee, da es sich ja auf die vorher gefundene Zelle beziehen muss.
Ich hoffe mein Anliegen ist zumindest etwas verständlich, ich versuche gern eine genauere Beschreibung bei Bedarf. Ein anhängen der kompletten Datei war leider auch nicht möglich.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Until Loop

16.01.2019 08:38:03

Werner

AW: VBA Until Loop

16.01.2019 08:48:28

Karoline

unklar

16.01.2019 09:00:01

UweD

AW: unklar

16.01.2019 09:09:28

Karoline

AW: unklar

16.01.2019 09:11:59

Karoline

ohne Schleife

16.01.2019 09:45:46

UweD

AW: ohne Schleife

16.01.2019 11:32:49

Karoline

mit Schleife

16.01.2019 09:58:04

Nepumuk

AW: mit Schleife

16.01.2019 10:15:43

Torsten

AW: mit Schleife

16.01.2019 11:33:49

Karoline

Sub try2() Dim i As Long Dim ApSe As Worksheet: Set ApSe = Sheets("April-Sep") Dim pv1 As Worksheet: Set pv1 = Sheets("01 Jan-Jun") Dim t As Double t = 43191 Do Until Cells(i, 1).Value = t 'copy paste ? t = t + 2.08333333333333E-02 Loop End Sub

Sub try2() Dim i As Long Dim ApSe As Worksheet: Set ApSe = Sheets("April-Sep") Dim pv1 As Worksheet: Set pv1 = Sheets("01 Jan-Jun") Dim t As Double t = 43191 i = 1 Do Until Cells(i, 1).Value = t 'copy paste ? t = t + 2.08333333333333E-02 i = i + 1 Loop End Sub

Hallo nochmal
Es ginge sogar nur mit Formel ohne VBA

=WENNFEHLER(SVERWEIS([@Date];'01 Jan-Jun'!$A:$B;2;0);"")

Wenn mit VBA, dann wird genau diese Formel benutzt und später das Ergebnis gegen Werte ersetzt.
Modul1

Option Explicit 
 
Sub try2() 
 
    Dim LR As Long, Z1 As Integer 
    Dim ApSe As Worksheet: Set ApSe = Sheets("April-Sep") 
    Dim pv1 As Worksheet: Set pv1 = Sheets("01 Jan-Jun") 
     
    Z1 = 3 'Erste Zeile mit Daten 
     
    With ApSe 
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
         
        With .Cells(Z1, 2).Resize(LR - Z1 + 1, 1) 
            .FormulaR1C1 = "=IFERROR(VLOOKUP([@Date],'" & pv1.Name & "'!C1:C2,2,0),"""")" 
            .Value = .Value 
        End With 
    End With 
 
End Sub

LG UweD

Public Sub Copy_Values() Dim avntValues As Variant Dim ialngIndex As Long Dim objCell As Range With Worksheets("01 Jan-Jun") avntValues = .Range(.Cells(4, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value End With For ialngIndex = LBound(avntValues, 1) To UBound(avntValues, 1) Set objCell = Worksheets("April-Sep").Columns(1).Find(What:= _ avntValues(ialngIndex, 1), LookIn:=xlFormulas, _ LookAt:=xlPart, MatchCase:=False) If Not objCell Is Nothing Then objCell.Offset(0, 1).Value = avntValues(ialngIndex, 2) Set objCell = Nothing End If Next End Sub

Sub kopieren() Dim WS1 As Worksheet: Set WS1 = Sheets("01 Jan-Jun") Dim WS2 As Worksheet: Set WS2 = Sheets("April-Sep") Dim lngRow As Long For lngRow = 2 To WS1.Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountIfs(WS2.Columns(1), WS1.Cells(lngRow, 1)) 0 Then WS1.Range("B" & lngRow).Copy WS2.Range("B" & WorksheetFunction.CountA(WS2.Columns(2)) + _ 1) End If Next lngRow End Sub

Beliebteste Forumthreads (12 Monate)

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