Bestimmte Zellen in neue Tabellen kopieren

[aeugeln87]

Hallo, folgendes Problem:

Wir haben eine Tabelle mit gut 100 Spalten und 4500 Zeilen und in jeder Zelle steht entweder "JA" oder "NEIN" als Ergebnis einer Formel.

Jetzt möchte ich jedes "NEIN", in Abhäbgikeit von dem Wert in Spalte A (kommt also öfter vor), in eine/viele neue Tabellen kopieren. 

Also jedes "NEIN", wo der Wert in Spalte A gleich ist, ist dann in der gleichen neuen Tabelle.

In der neuen Tabelle soll dann also die Spalte stehen wo das "NEIN" gefunden wurde und dazu die jeweiligen Werte der Spalten C,D und E. 

Folgendes ist von der Idee her ähnlich:http://www.supportnet.de/t/2437873

Wäre super wenn wir jemand helfen könnte. Vielen Dank.

Beste Grüße

[Jockel]

Hallo hier --> http://www.ms-office-forum.net/forum/sho...p?t=340549 hat jemand ein ganz ähnliches Problem...

[Gast 123]

Hallo

da im ms-Forum noch keine Antwort vorliegt kann man sich die Sache ansehen. Es fehlen aber konkrete Informationen!
Zum Programmieren muss man die Namen der Quell- und Zieltabelle kennen, und ab wo die "Nein" Spalten beginnen? Ich nehme an weil C,D,E kopiert werden soll das da kein "Nein" drin steht. Ebenso wissen wir nicht in welche Spalten in der neuen Tabelle kopiert werden soll. Auch das hier ist völlig unklar:

Jetzt möchte ich jedes "NEIN", in Abhäbgikeit von dem Wert in Spalte A (kommt also öfter vor), in eine/viele neue Tabellen kopieren. 

1)  in Abhaengigkeit von welchem Wert in Spalte A??  Wo findet man den??  Und ist es immer derselbe Wert??
2)  in eine/viele neue Tabellen.  Wie sagt man einem Makro was "viele" sind. Man kann 2,3 sagen, aber was sind viele??

kleiner Tipp von mir:  wenn du Hilfe willst stelle bitte eine Beispieldatei mit 10-15 Zeilen, und 10 Spalten ins Forum, damit wir erst mal sehen können wie diese Aufgabe konkret aussieht, bitte mit dem Wunschergebnis!  Wir können ja nicht "riechen" in welche Spalten in der Zieltabelle die Daten stehen sollen. Und in welcher Spalte angegeben werden soll in welcher Spalte in der Quelltabelle das "Nein" gefunden wurde??

mfg  Gast 123

[steve1da]

Hola,

scheint eine beliebte Frage zu sein...

http://www.vba-forum.de/forum/View.aspx?...n_kopieren

Gruß,
steve1da

[aeugeln87]

Hallo

da im ms-Forum noch keine Antwort vorliegt kann man sich die Sache ansehen. Es fehlen aber konkrete Informationen!
Zum Programmieren muss man die Namen der Quell- und Zieltabelle kennen, und ab wo die "Nein" Spalten beginnen? Ich nehme an weil C,D,E kopiert werden soll das da kein "Nein" drin steht. Ebenso wissen wir nicht in welche Spalten in der neuen Tabelle kopiert werden soll. Auch das hier ist völlig unklar:

1)  in Abhaengigkeit von welchem Wert in Spalte A??  Wo findet man den??  Und ist es immer derselbe Wert??
2)  in eine/viele neue Tabellen.  Wie sagt man einem Makro was "viele" sind. Man kann 2,3 sagen, aber was sind viele??

kleiner Tipp von mir:  wenn du Hilfe willst stelle bitte eine Beispieldatei mit 10-15 Zeilen, und 10 Spalten ins Forum, damit wir erst mal sehen können wie diese Aufgabe konkret aussieht, bitte mit dem Wunschergebnis!  Wir können ja nicht "riechen" in welche Spalten in der Zieltabelle die Daten stehen sollen. Und in welcher Spalte angegeben werden soll in welcher Spalte in der Quelltabelle das "Nein" gefunden wurde??

mfg  Gast 123

Ok, danke. Habe ich mal gemacht.

Vll. sollten aber auch einfach neue Dateien erzeugt werden, da ca. 150 neue Tabellen, aber mit relativ wenig Inhalt, entstehen werden.

Hoffe jetzt ist es verständlicher.

Beste Grüße

[atilla]

Hallo,

ist in jeder Zeile ein Nein zu finden?

Wenn nicht, soll der Datensatz dann nicht übernommen werden
oder soll er übernommen werden und die Spaltenbenennung bleibt leer?

[aeugeln87]

Hallo,

ist in jeder Zeile ein Nein zu finden?

Wenn nicht, soll der Datensatz dann nicht übernommen werden
oder soll er übernommen werden und die Spaltenbenennung bleibt leer?

Hallo, 

es ist nicht in jeder Zeile ein "NEIN" zu finden. Die Daten sollen nur übernommen werden, wenn es ein "NEIN" gibt.

Beste Grüße

[atilla]

Hallo,

unten stehenden Code in ein allgemeines Modul einfügen:

Code:

Sub tabellenAnlegen1()
   Dim i As Long
   Dim j As Long
   Dim k As Long, m As Long
   Dim x
   Dim loLetzte As Long, lngS As Long
   Dim strgText As String
   Dim wks As Worksheet
   Dim arr As Variant
   Dim D1 As Object
   Dim varK
   Set D1 = CreateObject("Scripting.Dictionary")
   On Error GoTo fehler
   Application.ScreenUpdating = False
   
   strgText = "NEIN"
   
   With Worksheets("Teilnehmende-Stammdatenblatt")                       'datentabelle
       loLetzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
       lngS = .Cells(1, .Columns.Count).End(xlToLeft).Column
       arr = .Range("A1:C" & loLetzte)
       For i = 3 To UBound(arr)
         x = Application.Match(strgText, .Rows(i), 0)
         If IsNumeric(x) Then
           D1(arr(i, 1)) = D1(arr(i, 1)) & "#" & arr(i, 2) & "#" & arr(i, 3) & "#" & x
         End If
       Next i
       
       For Each varK In D1.keys
         Set wks = Worksheets.Add(After:=Sheets(Sheets.Count))
         wks.Name = varK
         wks.Range("A1:B1").Value = .Range("B1:C1").Value
         wks.Range("C1").Value = "Spalte"
         k = 0
         m = 2
         strgText = Replace(D1(varK), "#", "", 1, 1)
         For j = 0 To UBound(Split(strgText, "#")) Step 3
           wks.Cells(m, 1) = Split(strgText, "#")(k)
           wks.Cells(m, 2) = Split(strgText, "#")(k + 1)
           wks.Cells(m, 3) = Replace(Cells(1, Val(Split(strgText, "#")(k + 2))).Address(0, 0), "1", "")
           m = m + 1
           k = k + 3
         Next j
       Next
       .Select                             'am Ende wieder Datentabelle auswählen
   End With
fehler:
   Application.ScreenUpdating = True
   Set wks = Nothing
   D1.RemoveAll
   Set D1 = Nothing
   If Err.Number > 0 Then MsgBox Err.Number & "  " & Err.Description

End Sub

Mit folgendem Code können alle Tabellen bis auf Tabelle "Teilnehmende-Stammdatenblatt" gelöscht und danach kann wieder der obige Code gestartet werden:

Code:

Sub tab_löschen()
Dim j As Integer

   For j = Sheets.Count To 1 Step -1
       If Sheets(j).Name <> "Teilnehmende-Stammdatenblatt" Then
           Application.DisplayAlerts = False
           Sheets(j).Delete
           Application.DisplayAlerts = True
       End If
   Next j
End Sub

Und unten noch einmal Deine Datei mit eingearbeitetem Code:


  Kopie von example-1.xlsm (Größe: 24,75 KB / Downloads: 10)

[Rabe]

Hi Atilla,

Und unten noch einmal Deine Datei mit eingearbeitetem Code:

zwei Sachen sind mir aufgefallen:

• Das Sortieren sollte das Teilnehmende-Blatt ausklammern
  
• wenn zwei mal NEIN in einer Zeile steht, wird im neuen Tabellenblatt nur das erste Auftreten in der Spalte C genannt. Evtl. wäre es sinnvoll, das auf weitere Spalten zu erweitern.
  

[atilla]

Hallo Ralf,

das Ende des Sortiermakros so:

Code:

Next
Sheets("Teilnehmende-Stammdatenblatt").Move before:=Sheets(1)
End Sub

Mit den zwei Nein hat der TE in seinem Beispiel auch nicht berücksichtigt.
Und außerdem würde es meinen schönen Code durcheinander bringen. :@


Aber Du hast recht, dass sollte wahrscheinlich auch rein. 
Ich warte aber noch, auch aus Zeitmangel.

Ach so, bevor ich es vergesse: Du solltest nicht nur negatives heraussuchen.
Ab und zu auch mal loben, denn sonst demotiviert es mich. :22: