Supportnet / Forum / Skripte(PHP,ASP,Perl...)

Hallo zusammen, ich kenne mich leider mit VBA für Excel nicht so gut aus, muss aber unbedingt damit etwas erstellen. Also ich habe mehrere Tabellenblätter. Mein Tabellenbaltt mit dem namen "Data" hat zwei Spalten. Eines mit unterschiedlichen Namen (Spalte c) und die andere (Spalte D) hat entweder die Zahl 1 oder 0. Nun brauche ich ein Skript, das in der Spalte d danach schaut, ob eine 1 vorkommt, wenn ja dann soll in der gleichen Zeile von der Spalte c der Name kopiert werden und in ein einer Worksheet eingefügt werden. Wenn keine 1 steht soll wieter gesucht werde (also in der Spalte D) bis eine 1 gefunden wurde. Es wäre echt nett wenn mir jemand helfen könnte. Danke

Hallo launsebay,

hier ein anfang:

dim suche as integer
dim einfg as integer

Sub Suchen()
sheets("Data").activate
suche = 1
einfg = 1
do while cells(suche, 4) <> ""
if cells(suche,4) >= 1 then
cells(suche, 3).copy
sheets(__________).activate               'die unterstriche durch einen blattnamen (in anführungszeichen) ersetzen!!!
do while cells(einfg,3) <> ""
end if
einfg = einfg + 1
loop    
cells(einfg,3).Select
    ActiveSheet.Paste
sheets("Data").activate
suche = suche + 1
loop
end sub

Code kopieren die excel datei öffnen -> alt + F11 -> auf die excel-datei: rechtsklick -> einfügen -> modul -> diesen code dort einfügen -> bei sheets(________).activate den richtigen blattnamen eintragen, wo die zelle hin kopiert werden soll
evtl. einen button machen: rechteck zeichnen -> rechtsklick: makro zuweisen ->suchen

kopiert momentan auf das vorgegebene tabellenblatt in spalte c

Danke für die super schnelle Antwort.

Ich habe dein Anweisungen gefogt, jedoch kommt beim starten die Fehlermeldung: "compile error" end if without block if

ich verstehe nicht ganz genau, was das heissen soll.

Kannst du mir vielleicht noch ein Tipp geben.

Gruss

Hallo launsbeay,

sorry war mein fehler, hier nochmal der richtige code:

dim suche as integer
dim einfg as integer

Sub Suchen()
sheets("Data").activate
suche = 1
einfg = 1
do while cells(suche, 4) <> ""
if cells(suche,4) >= 1 then
cells(suche, 3).copy
sheets(__________).activate               
do while cells(einfg,3) <> ""
einfg = einfg + 1
loop    
cells(einfg,3).Select
    ActiveSheet.Paste
sheets("Data").activate
end if
suche = suche + 1
loop
end sub

Ich habe das gemacht und bemerkt, dass sich nichts tat. Daher habe ich suche=7 und eing=7 gesetzt, da es bei mir im Sheet erst hier anfängt.
Jedoch bekomme ich jetzt einen Run time error. Und wenn ich dann auf mein Excel Tabellenblatt Data schaue ist die Zelle mit dem Namen als (einfg, 3) zwar richtig kopiert jedoch wurde es nicht im Tabellenblatt (sheet2) eingefügt.
Ich habe natürlich in der leeren Klammer Sheet2 geschrieben.

Weisst du vielleicht was ich falsch mache.

Danke nochmals

Zumindest kommt mit vor, dass in deinem script zwar paste erwähnt wird, aber ist damit auch sheet2 gmeint.

versuchs mal mit

sheet(2).activate

gruß Simon

oder sheets("Name_des_Blattes").activate

gruß Simon

also jetzt bekomme ich die Fehlermeldung:
Run-time error '9':

Subscript out of range

Ich glaube, das kommt, wenn man den Blattnamen nicht in Anführungsstriche schreibt ("Blattname")

z.B. sheets("Tabelle1").activate
oder nur mit der nummer (ohne anführungsstriche)
sheets(1).activate

Gruß Simon

Modifikation eingebaut:

Dim suche As Integer
Dim einfg As Integer

Sub Suchen()


Sheets("Data").Activate
suche = 7
einfg = 4
Do While Cells(suche, 4) <> ""
If Cells(suche, 4) = 1 Then
Cells(suche, 3).Copy
Sheets("results").Activate
Do While Sheets("results").Cells(einfg, 1) <> ""
einfg = einfg + 1
Loop
Sheets("results").Cells(einfg, 1).Select
ActiveSheet.Paste
Sheets("Data").Activate
End If
suche = suche + 1
Loop
End Sub


Also ich habe den Script etwas modifiziert. Jetzt klappt es auch. Nur mein Problem ist, dass jedesmal wenn ich mit neuen Daten im Sheet (date) fortfahre und dann auf play klicke , fann alle daten nochmal kopiert werde. jedoch überschreibt er die alten Daten nicht sondern fängt von Zeile 79 noch einmal von vorne an. Somit habe ich die Datensätze damit doppelt, können die alten daten nicht einfach überschrieben werden, also die alten mit den alten und dass ich am ende einfach die neuen hinzu bekomme?

Gruss

Hallo launsebay,

lösche einfach die daten, bevor das makro die Zellen kopiert

mit:

Dim suche As Integer
Dim einfg As Integer

Sub Suchen()
sheets("results").activate
range("C:C").clearcontents

Sheets("Data").Activate
suche = 7
einfg = 4
Do While Cells(suche, 4) <> ""
If Cells(suche, 4) = 1 Then
Cells(suche, 3).Copy
Sheets("results").Activate
Do While Sheets("results").Cells(einfg, 1) <> ""
einfg = einfg + 1
Loop
Sheets("results").Cells(einfg, 1).Select
ActiveSheet.Paste
Sheets("Data").Activate
End If
suche = suche + 1
Loop
End Sub

• excel formel - iteration?
• VBA-Editor öffnen und schließen
• VBA-Excel