Zellenwerte vergleichen wenn gleich spalte kopiere

Hallo ich bin nicht nur neu hier im Forum sondern habe auch gleich eine für mich mega schwere Aufgabe zu lösen, die mich in die Verzweiflung treibt.
Vielleicht kann mir irgend jemand helfen.
Also ich habe 2 Tabellenblätter. Im Tabellenblatt "Eingabe" werden Daten aus einem anderen Programm übernommen, die in Excel weiterverwendet sollen. Dazu muss ich sie neu anordnen, um sie auswerten zu können. Dies soll im Tabellenblatt "Ausgabe" geschehen.
Das Tabellenblatt Eingabe hat unter anderem eine Zelle (G2) in der ein Datum steht. Darunter steht in (G3) DS-T für Tagschicht. In der Spalte F sind Namen angeordnet Zu diesen Namen gibt es in Spalte (G) zugeordnete Funktionen. Das Gleiche gilt für Spalte H (H2)enthält ein Datum (H§) DS-N für Nachtschicht. Hier sind die Funktionen anders verteilt.
Im Tabellenblatt Ausgabe sind in Zeile 2 Datumsangaben, in Zeile 3 die jeweiligen Schichten (es gibt zu jedem Datum immer 2).In Spalte B befinden sich die Namen.
Mit einem Makro möchte ich gern das Tabellenblatt Ausgabe Zeile 2 durchsuchen ob das Datum aus Tabellenblatt (G2) darin enthalten ist. Wenn "ja", dann sollen die Werte den Namen zugeordnet im Tabellenblatt Ausgabe unter dem Datum entsprechend eingefügt werden.
Ich weiß klingt viel. Dennoch ist bald Weihnachten und ich vertraue darauf, dass es unter Euch den einen oder anderen Experten gibt, der das aus dem Ärmel schüttelt.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo nochmal,
so ist auch der Ausgabebereich flexibel.

Sub Ausgabe()
  Dim varOut As Variant, varName As Variant, varData As Variant, rng As Range
  Dim varRow As Variant, varCol As Variant
  Dim lngRow As Long, lngCol As Long, lngLastRow As Long, lngLastCol As Long

  With Sheets("Eingabe")
    Set rng = .Range("F2:H" & .Cells(.Rows.Count, 6).End(xlUp).Row)
  End With

  With Sheets("Ausgabe")
    lngLastRow = Application.Max(4, .Cells(.Rows.Count, 2).End(xlUp).Row)
    lngLastCol = Application.Max(3, .Cells(2, .Columns.Count).End(xlToLeft).Column)
    varName = .Range("B4:B" & lngLastRow)
    varData = .Range(.Cells(2, 3), .Cells(3, lngLastCol))
    varOut = .Range(.Cells(4, 3), .Cells(lngLastRow, lngLastCol))
    For lngRow = 1 To Ubound(varName, 1)
      varRow = Application.Match(varName(lngRow, 1), rng.Columns(1), 0)
      If IsNumeric(varRow) Then
        For lngCol = 1 To Ubound(varData, 2)
          varCol = Application.Match(varData(2, lngCol), rng.Rows(2), 0)
          If IsNumeric(varCol) Then
            If varData(1, lngCol) = rng.Cells(1, varCol) Then
              varOut(lngRow, lngCol) = rng.Cells(varRow, varCol)
            End If
          End If
        Next
      End If
    Next
    .Range(.Cells(4, 3), .Cells(lngLastRow, lngLastCol)) = varOut
  End With
  
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Sub AusgabeII() Dim varOut As Variant, varName As Variant, varData As Variant, rng As Range Dim varRow As Variant, varCol As Variant Dim lngRow As Long, lngCol As Long, lngLastRow As Long, lngLastCol As Long With Sheets("Eingabe") Set rng = .Range("F2:H" & .Cells(.Rows.Count, 6).End(xlUp).Row) End With With Sheets("Eingabe RTW") lngLastRow = Application.Max(6, .Cells(.Rows.Count, 2).End(xlUp).Row) lngLastCol = Application.Max(5, .Cells(3, .Columns.Count).End(xlToLeft).Column) varName = .Range("B6:B" & lngLastRow) varData = .Range(.Cells(3, 5), .Cells(4, lngLastCol)) varOut = .Range(.Cells(6, 5), .Cells(lngLastRow, lngLastCol)) For lngRow = 1 To Ubound(varName, 1) varRow = Application.Match(varName(lngRow, 1), rng.Columns(1), 0) If IsNumeric(varRow) Then For lngCol = 1 To Ubound(varData, 2) varCol = Application.Match(varData(2, lngCol), rng.Rows(2), 0) If IsNumeric(varCol) Then If varData(1, lngCol) = rng.Cells(1, varCol) Then varOut(lngRow, lngCol) = rng.Cells(varRow, varCol) End If End If Next End If Next .Range(.Cells(6, 5), .Cells(lngLastRow, lngLastCol)) = varOut End With End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Sub AusgabeII() Dim varOut As Variant, varName As Variant, varData As Variant, rng As Range Dim varRow As Variant, varCol As Variant Dim lngRow As Long, lngCol As Long, lngLastRow As Long, lngLastCol As Long With Sheets("Eingabe") Set rng = .Range("F2:H" & .Cells(.Rows.Count, 6).End(xlUp).Row) End With With Sheets("RTW Punkte") lngLastRow = Application.Max(6, .Cells(.Rows.Count, 2).End(xlUp).Row) lngLastCol = Application.Max(5, .Cells(3, .Columns.Count).End(xlToLeft).Column) varName = .Range("B6:B" & lngLastRow) varData = .Range(.Cells(3, 5), .Cells(5, lngLastCol)) varOut = .Range(.Cells(6, 5), .Cells(lngLastRow, lngLastCol)) For lngRow = 1 To Ubound(varName, 1) varRow = Application.Match(varName(lngRow, 1), rng.Columns(1), 0) If IsNumeric(varRow) Then For lngCol = 1 To Ubound(varData, 2) varCol = Application.Match(varData(3, lngCol), rng.Rows(2), 0) If IsNumeric(varCol) Then If varData(1, lngCol) = rng.Cells(1, varCol) Then varOut(lngRow, lngCol) = rng.Cells(varRow, varCol) End If End If Next End If Next .Range(.Cells(6, 5), .Cells(lngLastRow, lngLastCol)) = varOut End With End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

Zellenwerte vergleichen wenn gleich spalte kopiere

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

165 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellenwerte vergleichen wenn gleich spalte kopiere

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

165 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread