Microsoft Excel

Herbers Excel/VBA-Archiv

Zellenwerte vergleichen wenn gleich spalte kopiere


Betrifft: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Unwissender_bei_der_Arbeit
Geschrieben am: 02.12.2018 16:07:42

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.

  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Sepp
Geschrieben am: 02.12.2018 16:26:35

Hallo ?,

ohne aussagekräftige Beispieldatei mit ebenso aussagekräftiger Beschreibung wird das nichts werden!


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Unwissender_bei_der_Arbeit
Geschrieben am: 02.12.2018 17:06:29

http://www.herber.de/bbs/user/125834.zip


  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Sepp
Geschrieben am: 02.12.2018 17:14:50

Hallo Rüdiger,

Ausgabe

 ABCDEFGHIJKLMN
2  01.12.201801.12.201802.12.201802.12.201806.12.201806.12.201808.12.201808.12.201810.12.201810.12.201818.12.201818.12.2018
3 NamenDS-TDS-NDS-TDS-NDS-TDS-NDS-TDS-NDS-TDS-NDS-TDS-N
41aaa  test 1test6        
52bbb  test 2test 3        
63ccc  test 3test5        
74ddd  test 4test4        
85eee  test 5test1        
96fff  test 6test10        
107ggg  test 7test8        
118hhh  test 8test2        
129iii  test 9test7        
1310jjj  test 10test9        

Formeln der Tabelle
ZelleFormel
C4{=WENNFEHLER(INDEX(Eingabe!$G$5:$H$14;VERGLEICH($B4;Eingabe!$F$5:$F$14;0); VERGLEICH(C$2&C$3;Eingabe!$G$2:$H$2&Eingabe!$G$3:$H$3;0)); "")}
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Eingabe als Matrixformel! Formel nach rechts und unten kopieren!


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Unwissender_bei_der_Arbeit
Geschrieben am: 02.12.2018 17:33:59

Danke Sepp für deine Hilfe. Diese Lösung funktioniert perfekt, jedoch ist löst das mein Problem nicht ganz so wie ich es mir vorstellte. Sorry, ich habe mich bestimmt beschränkt ausgedrückt.
Die Formellösung bewirkt, dass ich die Daten in der Eingabetabelle stehen lassen muss, wenn ich die Daten aus der Ausgabe als Gesamtes zur Auswertung nutzen möchte.
Die Tabelle einhält Daten aus dem ganzen Jahr.
Deshalb hatte ich mir eine vba Lösung vorgestellt, bei der ich die Daten in der Eingabe hinterher auch verändern kann.
Sorry, wenn ich mich undeutlich ausdrücke.


  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Sepp
Geschrieben am: 02.12.2018 17:39:25

Hallo Rüdiger,

bleiben die Datenbereiche in 'Eingabe' immer gleich oder ändert sich deren Größe?


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Unwissender_bei_der_Arbeit
Geschrieben am: 02.12.2018 17:44:24

Hallo Sepp,
Die Liste der verschiedenen Namen und Funktionen in der 'Eingabe' ist etwas länger aber nicht mehr als 60.


  

Betrifft: AW: Zellenwerte vergleichen wenn gleich spalte kopiere
von: Sepp
Geschrieben am: 02.12.2018 18:07:46

Hallo Rüdiger,

in ein allgemeines Modul.

Modul Modul1

Option Explicit 
 
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 
 
  With Sheets("Eingabe") 
    Set rng = .Range("F2:H" & .Cells(.Rows.Count, 6).End(xlUp).Row) 
  End With 
 
  With Sheets("Ausgabe") 
    varName = .Range("B4:B13") 
    varData = .Range("C2:N3") 
    varOut = .Range("C4:N13") 
    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("C4:N13") = 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





 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: Flexibler
von: Sepp
Geschrieben am: 02.12.2018 18:14:53

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


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 02.12.2018 18:41:56

Vielen vielen Dank Sepp,
da kann Weihnachten ja kommen. Du hast mir sehr geholfen und mir jede Menge Kopfzerbrechen erspart.
Bleibt mir ein Rätsel, wie man das so schnell kann.


  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 03.12.2018 10:25:55



Hallo ich habe versucht, dieses Super- Makro auf weitere Tabellenblätter anzuwenden. Leider erschließt sich mir nicht was ich alles ändern muss damit es auch in Verbindung zu diesen funktioniert. D.h. Das Tabellenblatt Eingabe sollte gleich bleiben. Die Daten sollen jetzt in das Tabellenblatt 'Eingabe RTW'. Die Funktionsfelder die übernommen werden sollen sollen mit dem Datum in Zeile 3 den Diensten 'DS-T' und 'DS-N' abgeglichen und den Namen in Spalte B6:B55 zugeordnet werden. die Funktionsfelder gehen von E6:IO55. siehe Upload
Ich habe mich mehrfach versucht und bin auch daran kläglich gescheitert. Für weitere Hilfe bin ich überaus dankbar.


  

Betrifft: AW: Flexibler
von: Sepp
Geschrieben am: 03.12.2018 18:04:44

Hallo Rüdiger,

ohne Beispieldatei kann ich auch nur raten!


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 03.12.2018 18:17:15

Hallo Sepp, die Datei ist einfach zu groß, als dass ich sie irgendwie senden könnte. Wie gesagt die Eingabe ist identisch nur die Ausgabe so wie auf dem jpg.
Ich hoffe trotzdem dass du damit etwas anfangen kannst.


  

Betrifft: AW: Flexibler
von: Sepp
Geschrieben am: 03.12.2018 18:52:49

Hallo Rüdiger,

ohne gewähr!

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


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 03.12.2018 19:23:18

http://www.herber.de/bbs/user/125858.zip
Hallo Sepp,vielen lieben Dank, dass du dich meinem Problem annimmst. Ich habe das Makro ausprobiert. Leider übernimmt er nur jeweils die 1. Zeile der Eingabe in das Tabellenblatt RTW Punkte.

Ich habe in der Datei, die du schon kennst, versucht die Riesendatei so zu verkleinern, dass die Zellbezüge identisch sind. Wie oben gesagt sollen die Funktionen zu den ca. 50 Namen die in der Eingabe stehen würden in die Zellen E6:IO55 übernommen werden.

Die Datei habe ich als zip angehängt.
Danke!


  

Betrifft: AW: Flexibler
von: Sepp
Geschrieben am: 03.12.2018 19:54:40

Hallo Rüdiger,

sollte jetzt passen.

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


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 03.12.2018 20:01:49

Hallo Sepp
Es funktioniert. Das Wunder ist geschehen. Vielen Dank!!!

Wissen zahlt sich halt doch aus!

Also nochmals meinen Dank und Frohe Weihnachten, .... wenn man das schon sagen darf.;)

LG Rüdiger


  

Betrifft: AW: Flexibler
von: Unwissender_bei_der_Arbeit
Geschrieben am: 03.12.2018 19:55:12

Habe schon einen Fehler meinerseits entdeckt. Das Tabellenblatt heißt "Eingabe RTW" nicht "RTW Punkte". Trotz Änderung des Namens leider kein Erfolg. Hinzu kommt, dass er jetzt auch nicht mal die 1. Zeile übernimmt.
Ich glaube an Wunder.