Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.04.2024 20:05:21
28.04.2024 18:33:31
28.04.2024 18:25:12
28.04.2024 14:18:05
Anzeige
Archiv - Navigation
1932to1936
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
Inhaltsverzeichnis

Copy von Werten-

Copy von Werten-
03.07.2023 12:46:21
Stefan

Guten Tag und Servus liebe Herbers Excel-Forum Gemeinde

Ich versuche seit ca. 2 Wochen, zusammen mit ChatGPT ein, (in meinen Augen) relativ leichte Aufgabenstellung hinzubekommen
und bin langsam echt am verzweifeln ;)
Es geht darum aus einer kleinen Liste (5 Werte maximal) immer ein Wert nach dem anderen in eine Ziel Zelle zu kopieren.
Dabei soll nachgesehen werden falls in der Zielzelle bspw. der dritte Wert der Liste steht, sollte mit dem nächsten Wert also
dem vierten Wert der Liste weitergemacht bzw. kopiert werden. Dabei sollte jeder Wert für ca. 30 Sekunden stehen bleiben und mit dem nächsten
Wert der Liste ersetzt werden. Dabei gibt es noch 2 Dinge zu beachten neben der Spalte mit den Werten gibt es noch eine Spalte mit entweder einer 1 oder 0,
es sollten nur Werte kopiert werden die nebendran eine 1 haben und nicht die mit einer Null. Falls in der Liste nur einen einzigen Wert mit einer 1 in der benachbarten Spalte
gibt, sollte nicht kopiert werden und der Wert solange beibehalten werden bis es einen zweiten Wert mit einer benachbarten 1 gibt. Zusätzlich sollte nachdem der letzte Werte der Liste kopiert wurde, der Code wieder von Vorne beginnen und auch im besten fall 24/7 laufen und nicht stoppen.

Okay wenn ich so darüber nachdenke ist es vielleicht doch nicht so einfach wie ich angenommen hatte ;)
Als Referenz sende ich euch mal den kompletten VBA Code den ich bis heute mit ChatGPT hinbekommen habe,
leider läuft der Code nicht und es werden immer wieder Errors oder Fehler generiert-
ich bedanke mich bereits jetzt bei euch für eure Hilfe und wünsche euch einen super Tag!!!
Option Explicit

#If VBA7 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub CopyNextValue()
Dim currentValue As String
Dim nextValue As String
Dim rangeA As Range
Dim rangeB As Range
Dim cellA As Range
Dim cellB As Range
Dim copiedIndex As Long
Dim lastCopiedValue As String
Dim foundCell As Range ' Add this line to declare the foundCell variable

' Set the range to CC68:CC72
Set rangeA = Range("CC68:CC72")

' Set the range to CD68:CD72
Set rangeB = Range("CD68:CD72")

' Get the current value of DA4
currentValue = Range("DA4").Value

' Find the cell containing the current value
Set foundCell = rangeA.Find(What:=currentValue, LookIn:=xlValues, LookAt:=xlWhole)

' Get the index of the last copied value
If Not foundCell Is Nothing Then
copiedIndex = foundCell.Row - rangeA.Cells(1).Row + 1
Else
copiedIndex = 0
End If

' Set the last copied value
lastCopiedValue = currentValue

' Loop through the range starting from the next index
For Each cellA In rangeA.Cells(copiedIndex + 1).Resize(rangeA.Cells.Count - copiedIndex)
Set cellB = rangeB.Cells(cellA.Row - rangeA.Cells(1).Row + 1)

' Check if the cell in column CC is non-empty, has a 1 in column CD,
' and not equal to the last copied value
If cellA.Value > "" And cellB.Value = 1 And cellA.Value > lastCopiedValue Then
nextValue = cellA.Value
Exit For
End If
Next cellA

' If no next value found, start from the beginning
If nextValue = "" Then
For Each cellA In rangeA.Cells
Set cellB = rangeB.Cells(cellA.Row - rangeA.Cells(1).Row + 1)

' Check if the cell in column CC is non-empty, has a 1 in column CD,
' and not equal to the last copied value
If cellA.Value > "" And cellB.Value = 1 And cellA.Value > lastCopiedValue Then
nextValue = cellA.Value
Exit For
End If
Next cellA
End If

' Copy the next value to DA4
If nextValue > "" Then
Application.EnableEvents = False ' Disable events to prevent the OnTime event from triggering
Range("DA4").Value = nextValue
SendKeys "{ESC}"
Application.EnableEvents = True ' Re-enable events
End If

' Schedule the macro to run again after 15 seconds
Application.OnTime Now + TimeValue("00:00:15"), "CopyNextValue"

' Delay for 15 seconds before checking for the next
Sleep 15000 ' Sleep for 15 seconds (15000 milliseconds)
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Copy von Werten-
03.07.2023 13:03:18
onur
Du solltest die Datei posten statt eines Codes, der sowieso nicht funktioniert.
Ausserdem verstehe ich den Sinn und Zweck deines Anliegens überhaupt nicht. "Dabei sollte jeder Wert für ca. 30 Sekunden stehen bleiben und mit dem nächsten
Wert der Liste ersetzt werden" ???


AW: Copy von Werten-
06.07.2023 09:22:47
Stefan
Hallo Onur

Erstmal danke für deine Antwort und sorry für meine späte Rückmeldung.
Du hast Recht ich hätte das File direkt hochladen sollen - tut mir leid!
Die 30 sekunden kommen zustande da ich in der Zielzelle eine Abfrage habe und mir
dementsprechend welcher Wert dort eingetragen wird verschiedene Control-Charts sprich
Diagramme aufgebaut werden. Da ich mehrere Anlagen bzw. Diagramme auf einem Monitor
abbilden möchte wäre ich froh das ich ein Skript besitze das mir selbstständig durchgehend
die Werte in diese Zelle kopiert.
Viele Grüsse & Danke
https://www.herber.de/bbs/user/159825.xlsm


Anzeige
AW: Copy von Werten-
03.07.2023 18:40:06
Yal
Hallo Stefan,

vergiss den Sleep. Es bringt absolut nichts, weil Du eh den OnTime verwendest (Office 365 ist übrigens VBA7, spricht 64Bits).
Lasse den "nach zig Sekunden" zuerst beiseite. Nur einen Schritt auf einmal. Lasse dementsprechend das Makro mehrmals nacheinander laufen.
Lass den Code im Schritt-Modus laufen (F8), halte dabei das Lokalfenster offen (Ansicht, Lokalfenster). Es mag mühsam erscheinen, aber es ist lehrreich (auf dieser Art hättest Du in 2 Wochen viel gelernt).
Bei nur 5 Werte brauchst Du noch keine "Find(..)", es geht auch mit einem For-Schleife.

Ich gebe zu, wie Onur, dass es mir ohne Datei schwer fällt, das gesamt zu überschauen. In folgendem habe ich nur versucht, ein paar Unsinnigkeiten zu beseitigen, wie z.B. einen If-Then-Else der zuerst einen "Not" testen soll...

Sub CopyNextValue()
Dim currentValue As String
Dim i As Long
Dim copiedIndex As Long
Dim nextValue As String

' Find the cell containing the current value
    currentValue = Range("DA4").Value
    For i = 68 To 72
        If Cells(i, "CC").Value = currentValue Then
            copiedIndex = i
            Exit For
        End If
    Next

' Loop through the range starting from the next index
    If copiedIndex = 0 Then copiedIndex = 67
    For i = copiedIndex + 1 To 72
        With Cells(i, "CC")
            If .Value > "" And Cells(i, "CD").Value = 1 And .Value > currentValue Then
                nextValue = .Value
                Exit For
            End If
        End With
    Next

' If no next value found, start from the beginning
    If nextValue = "" Then
        For i = 68 To 72
            With Cells(i, "CC")
                If .Value > "" And Cells(i, "CD").Value = 1 And .Value > currentValue Then
                    nextValue = .Value
                    Exit For
                End If
            End With
        Next
    End If

' Copy the next value to DA4
    Application.EnableEvents = False ' Disable events to prevent the OnTime event from triggering
    If nextValue > "" Then Range("DA4").Value = nextValue
    Application.EnableEvents = True ' Re-enable events
End Sub
VG
Yal


Anzeige
AW: Copy von Werten-
06.07.2023 09:26:56
Stefan
Hallo Yal

Erstmal ein riesen Dankeschön für deine Bemühungen und tollen Tipps mit dem Fenster im VBA Menü,
werde ich ab sofort ein Auge drauf werfen!
Ich habe hier mal die Datei angehängt - leider funktioniert dein Code nicht wie gewünscht.
Aus der Zielzelle werden die eingetragenen Daten verwendet um Control-Charts sprich Diagramme
aufzubauen. Deshalb wäre meine Idee alle 30 Sekunden den nächsten Wert einzutragen um mehr
Diagramme auf einem Monitor abbilden zu können. Vielleicht könntest Du bei Gelegenheit nochmal
drüber gucken und mir nochmals auf die Sprünge helfen - wäre wirklich mega dankbar da ich im thema
VBA noch ein richtiger Neuling bin leider....

https://www.herber.de/bbs/user/159825.xlsm

Viele Grüsse und vielen Dank
Stefan


Anzeige
Aber eigentlich...
03.07.2023 18:56:38
Yal
... sind die Werte schon vorher bekannt. Man muss sie nur sammeln und jede 15 Sekunden eine neue ausgeben.

Dim Liste

Sub Liste_herstellen()
Dim i
Dim StartPkt

    For i = 0 To 4
        If Cells(i + 68, "CC").Value = Range("DA4").Value Then
            StartPkt = i + 1
            Exit For
        End If
    Next
    Liste = Array()
    For i = StartPkt To StartPkt + 5
        If Cells(68 + i Mod 5, "CD") = 1 Then
            With Cells(68 + i Mod 5, "CC")
                If .Value > "" Then
                    ReDim Preserve Liste(UBound(Liste) + 1)
                    Liste(UBound(Liste)) = .Value
                End If
            End With
        End If
    Next
End Sub

Sub ausgeben()
Dim Elt
    For Each Elt In Liste
        Range("DA4").Value = Elt
        DoEvents
        Application.Wait Now + TimeValue("00:00:15")
    Next
End Sub
VG
Yal

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige