Supportnet / Forum / Tabellenkalkulation

Mein Problem: Ich habe in Blatt 1 in Spalte A: verschiedene Zahlen z. B: A: 2212; 3715; 5614 im Blatt 2: erscheinen diese Zahlen wiederholt in Spalte F, nun muss ich die Zahlen der Spalte A aus Tabelle 1 in Tabelle 2 in Sp F suchen, die Reihen mit der jeweils gefundenen Zahl sollen heraus kopiert werden und in ein neues Datenblatt, das den Namen der Zahl (z. B. 2212) erhält, kopiert werden. Wer kann mit einem VBA helfen?

Hallo,

ich bin mir nicht sicher ob ich es richtig verstanden habe. Meine Version

In Tabelle 1 Spalte A stehen verschiedene Zahlen. In Tabelle 2 Spalte F stehen ebenfalls unterschiedliche Zahlen. Es sollen die Zahlen aud beiden Tabellen gesucht werden die Identisch sind und in Tabelle 3 geschrieben werden, nur die Zahl oder ist noch mehr zu machen.

Gruß

Helmut

Vielen DAnk für die schnelle Reaktion!
In Tabelle 1 stehen in Spalte A die Codes einer Substanz nur jeweils 1mal z. B. A: "2212"; "3715"; "5614", Diese Codes aus Tab1 sollen in Tabelle 2 Spalte F gesucht werden (kommen dort mehrmals vor). Von den Zeilen mit den jeweils identischen Codes sollen die Spalte A- D und F-H kopiert werden und in ein neu einzufügendes Blatt, das den Namen des Codes bekommen soll, eingefügt werden.
In den neuen Tabellenblättern: "2212"; "3715"; "5614" stehen die Angaben jetzt in Spalte A-G. Die Spalte A enthält eine Proben-Nr. Diese PrNr kann in allen Tabellenblättern "2212"; "3715"; "5614" auftauchen. Nun sollen die Tabellen entsprechend der PrNr. in Sp. A wieder in enem neuen Tabellenblatt zusammengesetzt werden. Z. B. Tabelle X enthält von A-G die Proben von "2212" , bei gleicher PrNr von H-N die Proben aus Tab "3715" usw., . Ist die PrNr z. B. von "3715" noch nicht im Tabellenblatt X vorhanden, soll die PrNr zur leichteren Suche auch in Spalte A geschrieben werden die restlichen Angaben entsprechend der CodesAngabe in Spalte H-N.
Bsp.:
Tabelle 1,
Spalte A
"2212";
"3715";
"5614"
Tabelle 2 in
Spalte A ... Spalte F ...
23AA56 .... 2212
23AA56 .... 2212
465BB ... 3715
465BB .... 5614
23AA56 ..... 3715
125A56 ..... 3715
986.................5614
neue Blätter enthalten:
Blatt "2212"
Spalte A .......Spalte E
23AA56 ....... 2212
Blatt "3715"
Spalte A ..... Spalte E
465BB ...... 3715
23AA56 .... 3715
125A56 ..... 3715
Blatt "5614"
Spalte A .... Spalte E
465BB ...... 5614

In Blatt X soll jetzt erscheinen:
Spalte A .....Spalte E ....Spalte H ...SpalteM ...Sp.O.... SpT
23AA56......2212 ........23AA56 .....3715
465BB .........................465BB ...... 3715........465BB .... 5614
986 .......................................................................986.........5614

Ich hoffe, das ist verständlich dargestellt.
Vielen Dank

Hallo,

jetzt ist es klar.

Könntest du eine Beispieltabelle vielleicht hier einstellen, damit würde man sich den Aufwand des Nachbaus sparen

http://www.netupload.de/

und den Link dann hier hinterlegen.

Wahrscheinlich wäre es auch sinnvoll die Probennummern zu sortieren, hier wäre interessant nach welchem Kriterien sortiert werden soll.

Gruß

Helmut

Hallo,

noch einige Fragen:

Steht in der Tabelle 2 was in Spalte A bis F?

Wenn ja, sollen diese Werte auch übertragen weden?

Warum stehen z.B. die Werte aus Tabellenblatt 2 F, hier "2212" in Tabelle 2212 nicht in Spalte F sondern E?

Warum werden auf dem Blatt X die Werte so angeordnet (gehe zur Zeit von Leerfeldern zwischen den Angaben aus)?

Warum werden bei jedem Wert die Probennummer oder umgekehrt bei jeder Probennummer der wert wiederholt?

Werden die Listen ausgedruckt oder dienen diese nur zum Finden eine Probe mit bestimmten Inhaltsstoffen?

Könnte man das Ganze vielleicht auch über eine Suchfunktion erledigen?

Gruß

Helmut

Hallo Saarbauer,

Vielen Dank für Dein Interesse, ich habe die Datei jetzt in
http://www.netupload.de/detail.php?img=1dbc7b442ca3b9d09792b5d4374234a4.xls

gestellt.

Ich habe auch Deine Fragen dazu beantwortet und noch einige Kommentare in die einzelnen Blätter geschrieben.

Vielen Dank für die Mühe.
MfG
emap

Hallo,

werde mir das Ganze mal heute Abend ansehen, aber auf den ersten Blick ist es klarer was du vorhast

Gruß

Helmut

Hallo Saarbauer,

ich habe gerade gesehen, ich habe das Makro, dass ich versucht habe, um zu schreiben, nicht gelöscht, kannst Du auf jeden Fall löschen.

Vielen Dank
MfG
emap

Hallo,

seh dir mal das an, könnte deinen Vorstellung entsprechen

http://www.netupload.de/detail.php?img=adf8775190bc3344b9ba549fc23c...

und einfach das eingebaute Makro mit "Strg" + "s" starten

Gruß

Helmut

Hallo,

habe gerade festgestellt die Option hat er nicht genommen, also "Strg" + "s" funktioniert nicht. Makro normal starten

Gruß

Helmut

Hallo Saarbauer,
vielen Dank für Deine Mühe.
Ich habe das mal probiert, es bleibt leider im fett markierten Bereich hängen, also dort, wo die Tabelle "Ende" angelegt werden soll.

For i = 3 To letztesBlatt
Sheets(i).Select
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("H:IV").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:G" & Range("G65536").End(xlUp).Row).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

Vielleicht kannst Du noch einmal schauen.

MfG
emap

Hallo Saarbauer,
ich habe es noch einmal versucht. Ich habe dabei die gesamte Prozedur in Unterprozeduren geteilt. Dabei fiel auf, dass die letzte Prozedur auch noch in der letzten Zeile hängt, die ja die gleiche scheint, wie vorher. Ich weiß nicht genau, ob ich richtig liege, aber scheint eine Art von Sortierung in der Tabelle nach der PrNR zu sein.

Als ich die Zeilen, an denen er hängt, ausgeklammert habe, läuft es in den Teilprozeduren und in der gesamten Prozedur wunderbar.

Vieleicht kannst Du mich aufklären, was da am Sortieren nicht richtig ist.

Vielen Dank für die Hilfe, die Tabelle Ende zusammenzustellen hätte ich nicht geschafft. An den Teiltabellen hatte ich mich schon versucht und mit viel Mühe etwas umständlicher hinbekommen.

Hier mal meine Version, vielleicht kannst Du mir da ein paar Tips geben, da ich ja beim Lernen von VBA bin, falls es Dich nicht zu viel Zeit kostet.

Sub neue_Tabelle()

Sub Spalte_BG()
´
´`Spalte einfügen, in die die Werte für BG/NG (ursprünglich in Spalte n O) geschrieben werden

Dim j As Integer

Columns("J:J").Select
Selection.Insert Shift:=xlToRight

For j = 2 To ActiveSheet.Range("F65536").End(xlUp).Row
On Error Resume Next
If Range("I" & j) = "01" Then
Cells(j, 10) = Cells(j, 15)
ElseIf Range("I" & j) = "02" Then
Cells(j, 10) = Cells(j, 16)
Else: Cells(j, 10) = ""
End If
Next j

End Sub

´ hier Procedur für Anlegen der Teilblätter
SpalteUrF = Sheets("Urdatei").Range("F65536").End(xlUp).Row
SpCode = Sheets("Code").Range("A65536").End(xlUp).Row
Set such = Sheets("Code").Range("A2:A" & SpCode)

´Eingabedialog für Suchbegriff und neues Blatt anlegen und mit Toxin benennen
For Each zahler In such ´= Sheets("Code").Range(1, 2) To Sheets("Code").Range("A2:A" & SpCode)
For Blatt = 1 To Worksheets.Count
If Sheets(Blatt).Name = zahler Then Blatt_vorhanden = True
Next
If Blatt_vorhanden = False Then
With Worksheets.Add
.Move After:=Worksheets(Worksheets.Count)
.Name = zahler
End With
End If
Next zahler

` Daten mit entsprechenden Codes filtern und in Toxin-Blatt kopieren
SpalteUrF = Sheets("Urdatei").Range("F65536").End(xlUp).Row

Application.ScreenUpdating = False
Sheets("Urdatei").Select
For I = 2 To SpalteUrF
Tox = Sheets("Urdatei").Cells(I, 6)
Worksheets("Urdatei").Range("A" & I & ":H" & I).Copy
Sheets(Tox).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
Worksheets("Urdatei").Range("A1:H1").Copy
Sheets(Tox).Cells(1, 1).PasteSpecial
Next

End Sub



Vielen Dank!!!!
Mfg emap

Hallo,

das Problem mit der Sortierfunktion hängt mit der Version von Excel zusammen, habe das Progtramm mit 2003 erstellt, funktioniert unter 2000 oder früher nicht.

Habe es jetzt auf 2000 getestet

die Zeilen

Range("A1:G" & Range("G65536").End(xlUp).Row).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

sollest du auskommentieren ( ein ´ davorsetzen)

Gruß

Helmut

Hallo Saarbauer,
ich hatte bereits auskommentiert und eine ähnliches Sortierkommando eingesetzt.

Vielen Dank für Deine Hilfe, es funktioniert alles wunderbar.
MfG
emap

Hallo Saarbauer,
hier noch einmal eine Frage zum Programm vom 04.12.06

es läuft an sich bis auf einige Unstimmigkeiten.
1. Wenn die PRNR mit gleichem Tox-Code doppelt vorhanden ist, bricht er das Einfügen der Datensätze der Untertabelle in die Tabelle „Ende“ ab und geht zur nächsten Untertabelle. Dann fehlen mir allerdings Tox-Codes mit den Angaben.
2. Wenn nach rein numerischen PRNR andere PRNR mit alpha-numerischer Schreibweise (PRNR: 23445, 5467, 5678, CV789, CV5984, )kommen, findet er die Codes nicht mehr und schreibt sie noch einmal in die Tabelle „Ende“ so dass ich u. U. die gleiche PRNR 4x in der Datei habe z. B.

Liegt das vielleicht an der Länge meiner Tabelle, oder kann er die PrNr nicht mehr erkennen, wenn eine alpha-numerische Schreibweise kommt. Wäre es dann besser, nach jedem Bearbeiten einer Untertabelle noch einmal sortieren zu lassen. Wie schreibe ich dann den Code und an welcher Stelle. Ich habe schon einige Möglichkeiten versucht, die nicht funktionieren.


Sub Einzeltabellen()
´ Anlegen der Blätter ASP und DSP, um Codes in unterschiedlichen Blättern zusammenzufassen
letztesBlatt = ActiveWorkbook.Sheets.Count
Tabelle_ASP = True
For I = 1 To letztesBlatt
If Worksheets(I).Name = "ASP" Then
Tabelle_ASP = False
Exit For
End If
Next I
Sheets("Urdatei").Select
letzteZeile = Range("A65536").End(xlUp).Row
If Tabelle_ASP Then
With Worksheets.Add
.Name = "ASP"
End With
End If

´aus den Codes-Tabellen werden die Proben nach der ProbenNr mit unterschiedlichen
´ Tox-Codes zusammengefasst
Dim A, ASP(15)
Dim S, DSP(22)
Dim letzteZeASP As Long
Dim letzteSpASP As Long

ASP(0) = "3403051"
ASP(1) = "3403052"
ASP(2) = "3403034"
ASP(3) = "3403031"
ASP(4) = "3403032"
ASP(5) = "3403033"


Sheets(ASP(0)).Select
´Rows(1 & ":" & Range("J65536").End(xlUp).Row).Select
Range("A1:J" & Range("J65536").End(xlUp).Row).Select
Selection.Copy
Sheets("ASP").Select
Range("A1").Select
ActiveSheet.Paste
´Sheets("ASP").Range("K:K").Select
´Selection.Delete

For A = 1 To 6
Sheets(ASP(A)).Select
Name = Sheets(ASP(A)).Name
Zeile = Range("D65536").End(xlUp).Row
ASPZeile = Range("ASP!D65536").End(xlUp).Row
ASPSpalte = Range("ASP!IV1").End(xlToLeft).Column

hw = 0
For j = 1 To Zeile
For k = hw + 1 To ASPZeile
If Range("ASP! D" & k).Value = Range(Name & "!D" & j).Value Then
Sheets(Name).Select
Range(Cells(j, 4), Cells(j, 10)).Select
Selection.Copy
Sheets("ASP").Select
Cells(k, ASPSpalte + 1).Select
ActiveSheet.Paste
hw = k
k = ASPZeile
Else
If k = ASPZeile Then
Sheets(Name).Select
Range(Cells(j, 1), Cells(j, 4)).Select
Selection.Copy
Sheets("ASP").Select
Cells(k + 1, 1).Select
ActiveSheet.Paste
Sheets(Name).Select
Range(Cells(j, 4), Cells(j, 10)).Select
Selection.Copy
Sheets("ASP").Select
Cells(k + 1, ASPSpalte + 1).Select
ActiveSheet.Paste
End If
End If
ASPZeile = Range("ASP!D65536").End(xlUp).Row
Next k
Next j
Application.CutCopyMode = False
Sheets("ASP").Select
letzteZeASP = Sheets("ASP").Range("D65536").End(xlUp).Row
letzteSpASP = Sheets("ASP").Range("IV1").End(xlToLeft).Column
Sheets("ASP").Range(Cells(1, 1), Cells(letzteZeASP, letzteSpASP)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Next A

Nachdem ich den unteren Teil zum Sortieren dazugeschrieben habe, erscheinen jetzt noch mehr Codes in der Tabelle ASP.

Was muss ich da ändern, bei nur 2 Tox-Codes macht er noch , was er soll.
Kannst Du mich aufklären?
Gruß Emap

Hallo,

leider sind in deinem VBA-Code einige Angaben die mit meinen Dateien nich nachvollziebar sind, da Blödsinn rauskommt.
So bringt z.B. die Zeile

kein vernüftiges Ergebnis, da in den mir vorliegenden Tabellen in Spalte J nichts steht.

Hast du mal deien Datei im Einzelschrittmodus abgefahren?

Gruß

Helmut

Hallo Saarbauer,
mit Deiner Probedatei klappt das auch wunderbar. Bei mir klappt es im großen und ganzen auch, bis auf dieses Problem. Ich habe eine Datei mit über 10.000 DS und da gibt es das Problem.
In meiner jetzigen Datei habe ich Angaben von A-J, die PRnR steht in D der Tox-Code(Untertabellen) in E. Es werden auch die Codes in die Tabelle "ASP" (bei Dir Ende) geschrieben, nur sobald eine PrNR mit einem alpha-numerischen Code, z. B. CV789, kommt, kann er die PrNr davor nicht mehr finden und tut so, als gibt es die PrNr noch nicht und erfasst sie in SpalteA-C (allg. Angaben) neu, so dass ich dann die PrNr u. U. doppelt und dreifach drin habe. Mir fiel als Lösung ein, dass nach jedem Tabellendurchlauf der Untertabelle die Tabelle ASP (Ende) neu sortiert werden müsste, so dass die PrNr mit alpha-numerischer Bezeichnung beim nächsten Tabellen-Durchlauf immer am Ende stehen.
Daher habe ich diese Zeilen noch dazu geschrieben. Allerdings muss hier etwas fehlen, oder die Position ist falsch oder ????. Jetzt schreibt er nämlich fast alle Proben doppelt.

 letzteZeASP = Sheets("ASP").Range("D65536").End(xlUp).Row
letzteSpASP = Sheets("ASP").Range("IV1").End(xlToLeft).Column
Sheets("ASP").Range(Cells(1, 1), Cells(letzteZeASP, letzteSpASP)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Ich hoffe, ich war verständlich.

MfG
emap

• Makro
• Excel Tabelle mit Verknüpfung kopieren
• VBA Werte finden uns kopieren ???
• Aktuelles Tabellenblatt in Excel mit Makro kopieren
• Zeilen in ein anderes Blatt kopieren und gleichzeitig sortieren