Thema Datum  Von Nutzer Rating
Antwort
Rot Auflistung meiner Daten klappt nicht richtig
31.07.2023 16:08:00 Reinhold
NotSolved
31.07.2023 22:49:45 Gast42222
NotSolved
01.08.2023 12:00:01 Reinhold
NotSolved
01.08.2023 14:19:19 Gast70714
*****
Solved
01.08.2023 14:42:29 Reinhold
NotSolved
01.08.2023 16:55:34 Gast15304
Solved

Ansicht des Beitrags:
Von:
Reinhold
Datum:
31.07.2023 16:08:00
Views:
315
Rating: Antwort:
  Ja
Thema:
Auflistung meiner Daten klappt nicht richtig

Hallo, 

wäre für eure Hlfe sehr dankbar. Bin Anfänger.

Der nachfolgende VBA Code liest zwar die Daten aus, schreibt mir aber alles untereinander, anstatt
die entsprechden Daten in die gleiche Zeile.

Ich muss aus einer Exceltabelle aus den Zeilen 14 bis 21 die Spalte A (Ist Text) auslesen und die gesamte Zeile prüfen,
ob Zellen blau eingefäbt sind. Es geht um eine Timingliste wo die KWs blau eingefärbt sind. 
Bei blau eingefärbten Zellen dann in Zeile 3 die Entsprechend KW ermitteln

Nun möchte ich erreichen, dass ab Zeile 50 die Daten aus Zeile 14 stehen und aus Zeile 15 die Daten auf Zeile 51 usw. usw.

Momenta werden zwar die Daten ermittel, aber in meinen Zelle ab Zeile 50, wird alles zu Text aus Zeile 14 aufgelistet. Also so

Text Zeile 14   22
Text Zeile 14        23
Text Zeile 14                25 usw.
 

Richtg wäre 
Text Zeile 14   22  23
Text Zeile 15   25 
Text Zeile 16   27         29  usw.

Ohje, ich hoffe ich konnte es halbwegs verständlich schildern.

LG Reinhold

Sub SucheKalenderwoche()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim kalenderwoche As Long
Dim outputRow As Long

Set ws = ThisWorkbook.Sheets("Timingeins") ' Ersetze "DeinBlattName" durch den Namen deines Blatts
Set rng = ws.Range("14:21") ' Die zu überprüfende Zeile 14
outputRow = 50 ' Zeile, in der die Kalenderwochen ausgegeben werden sollen

' Loop durch jede Zelle in der Zeile
For Each cell In rng
    ' Überprüfe die Farbe der Zelle (Blau - Farbcode 33)
    If cell.Interior.Color = RGB(0, 176, 240) Then
        ' Wenn die Zelle blau ist, ermittel die Kalenderwoche aus Zeile 3
        kalenderwoche = ws.Cells(3, cell.Column).Value

        ' Gib den Text aus Zelle A14 in Zeile 50, Spalte A, aus
        ws.Cells(outputRow, "A").Value = ws.Cells(14, "A").Value

        ' Gib die ermittelte Kalenderwoche in der gewünschten Zeile aus (ab Zeile 50)
        ws.Cells(outputRow, cell.Column).Value = kalenderwoche

        ' Inkrementiere die Ausgabezeile für die nächste gefundene Kalenderwoche
        outputRow = outputRow + 1
    End If
Next cell

' Zusätzliche Schleife, um die Zeilen 15 bis 21 einzutragen
For i = 14 To 21
    ' Gib den Text aus Zelle A15 bis A21 in Zeile 50 und folgenden Zeilen in Spalte A aus
    ws.Cells(outputRow, "A").Value = ws.Cells(i, "A").Value

    ' Inkrementiere die Ausgabezeile für die nächste Zeile
    outputRow = outputRow + 1
Next i
End Sub


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Auflistung meiner Daten klappt nicht richtig
31.07.2023 16:08:00 Reinhold
NotSolved
31.07.2023 22:49:45 Gast42222
NotSolved
01.08.2023 12:00:01 Reinhold
NotSolved
01.08.2023 14:19:19 Gast70714
*****
Solved
01.08.2023 14:42:29 Reinhold
NotSolved
01.08.2023 16:55:34 Gast15304
Solved