Hallo zusammen. Würde gerne aus tab.1 a1:a99 alle werte auslesen wenn die jeweilige bsp. linke zelle den inhalt „ja“ hat. die ausgelesenen werte sollen in der tab.2 nach einander wiedergegeben werden.
Bsp Tab.1
A … D
projekt1… ja
projekt2… nein
projekt3… nein
projekt4… ja
Tab.2 sollte dann das ergebnis anzeigen
G
Projekt1
projekt4
…
denke das problem ist nur mit einem vba zu lösen. besitze leider nicht das knowhow dafür. wäre super wenn einer von euch mir da helfen könnte.
danke
Ich nehme an, Du verwendest Excel, Du schreibst aber nur „Tabelle“. Unten ein einfaches Beispiel für ein Excel-Makro.
Startzeile ist 1. Das Makro geht der Reihe nach die Zellen der Spalte D durch, solange dort irgendein Wert enthalten ist (endet also automatisch, wenn eine Zelle in D leer ist). Wenn in der Zelle der Inhalt „ja“ vorgefunden wird, schaut das Makro, was in der selben Zeile in Spalte A steht und trägt das in Spalte G ein
Ich hoffe, das hilft Dir! (Mit den Formatierungstags stimmt was nicht, aber ich denke, man kann es lesen).
Viele Grüße,
Stefanie
Dim Zeile As Integer
Sub Makro1()
Zeile = 1
Do While Not Range(„D“ & Zeile).Value = „“
If Range(„D“ & Zeile).Value = „ja“ Then
Range(„G“ & Zeile).Value = Range(„A“ & Zeile).Value
End If
Zeile = Zeile + 1 'Nächste Zeile aufrufen
Loop
End Sub
sorry…hab nicht wirklich Zeit.
Syntaktisch: für (for)jede Zeile (ID)in Tabelle 1 Wenn (If) Tabelle 1 Spalte 2 = ja dann (then) kopiere den Inhalt in Tabelle 2)
Ist also eine verschachtelte Anweisung mit For und If-Then.
Hoffe jemand anderes erklärts besser.
Viel Erfolg
Stefan
denke das problem ist nur mit einem vba zu lösen. besitze
leider nicht das knowhow dafür. wäre super wenn einer von euch
mir da helfen könnte.
danke
Hallo lieber Eddy81,
Du hast vollkommen Recht. Mit vba lässt sich das schnell und einfach lösen.
Aber Frage an Dich: Warum sollte ich Dich in Deiner Faulheit unterstützen?
Es ist auch keine Schande, Orthographie und Interpunktion richtig anzuwenden. Es zeugt eher von Respekt dem anderen gegenüber. (Derjenige, von dem Du ja etwas willst). Wir sind hier nicht im Chat auf unterster Stufe.
Falls Du Interesse an einem VBA-Einstieg hast, versuch mal ein Makro aufzuzeichnen (Menü Extras/Makro/Aufzeichnen) und schau Dir einfach mal mit (Menü Extras/Makro/Visual Basic Editor) an, was Excel da so aufgezeichnet hat.
Es gibt da auch wirklich gute Seiten mit kompletten freien Büchern zu dem Thema.
Ich helfe Dir wirklich gerne bei ganz konkreten Fragen.
Grüße, Jens
Hallo Stafanie und Mitmensch,
vielen Dank für Eure schnelle Hilfe.
Gruß
Hi. hab das Makro dierekt angepasst und ausprobiert. Funktioniert gut nur werden die Daten die bereits in der Tab.2 vorhanden sind mit den neuen Daten kopiert, somit gibt es viele Wiederholungen. Mein Lösungsansatz war:
„Sheets(2).Range(„A1:A30“).Clear“ zum Beginn hin.Ist vielleicht nicht die eleganteste Lösung aber zumindest eine die funktioniert.
Ein weiteres Problem, was mich schon zwei Nächte gekostet hat, ist der definierte Bereich der Tab.2. Ich komm einfach nicht drauf wie ich den Befehl modifizieren soll.Ziel sollte es sein i zu begrenzen und den Wiedergabebereich auf Bsp A5:A100 definieren. Nach dem Bereich soll eine anderer deffinierter Bereich Bsp. A102:A200 folgen. Falss ihr euch fragt was das soll, es sind personenspez. Bereiche d.h. in dem jeweiligem Bereich will ich alle Projekte an den die Person A teilnimmt auflisten. Hoffe ihr könnt mir da weiter helfen. Hier das bisherige Makro…
Sub Makro1()
Dim Zeile As Integer
Dim Bereich As Range
Zeile = 1
Sheets(2).Range(„A1:A100“).Clear
Do While Not Range(„B“ & Zeile).Value = „“
If Range(„B“ & Zeile).Value = „Ja“ Then
i = Sheets(2).Cells(65536, 1).End(xlUp).Row + 1
Sheets(2).Cells(i, 1) = Range(„A“ & Zeile).Value
i = i + 1
End If
Zeile = Zeile + 1 'Nächste Zeile aufrufen
Loop
End Sub
Hi versuch mal den script für dich umzubauen:
*********************************************
Sub Kabel_Aktualisieren()
'Tabelle Kabel aktualisieren
Dim iRows, iEmpty, iPosRead, iPosWrite As Integer
Dim wsKabel As Worksheet
Set wsKabel = Worksheets(„Kabel“)
iRows = Tabelle4.Rows.Count
iPosRead = 1
iPosWrite = 3
iEmpty = 0
Dim rangeNew As Range
On Error GoTo 0
'Spalte A löschen um evtl. alte Positionen los zu werden
Set rangeNew = wsKabel.Range(„A2“, „A“ & iRows)
rangeNew.Cells.ClearContents
'Schleife über alle Zeilen
While iPosRead 20 Then
iRows = 0
End If
If Tabelle4.Cells(iPosRead, „A“).Value = Empty Then
iEmpty = iEmpty + 1
Else
iEmpty = 0
End If
'Wenn die Spalten A und B fett und kursiv sind, dann handelt es sich um
'eine Kabelbeschreibung, die nur einmal vorhanden ist
'Diese wird nach wsKabel
If Tabelle4.Cells(iPosRead, „C“).Font.Bold = True Then
If Tabelle4.Cells(iPosRead, „C“).Font.Italic Then
If Tabelle4.Cells(iPosRead, „D“).Font.Bold = True Then
If Tabelle4.Cells(iPosRead, „D“).Font.Italic = True Then
wsKabel.Cells(iPosWrite, „A“).Value = Tabelle4.Cells(iPosRead, „C“).Value & ", " & Tabelle4.Cells(iPosRead, „D“).Value
iPosWrite = iPosWrite + 1
End If
End If
End If
End If
iPosRead = iPosRead + 1
Wend
End Sub
*********************************************
wenn ich mehr zeit habe und es nicht funktionieren sollte kann ich evtl. den script noch weiter umbauen
Versuchs doch mal so: (Du Brauchst hier noch kein VBA außer du willst etwas ein bischen komplizierteres)
öffne deine Mappe—Schreibe „=“ in Tabelle 2, D1 (nicht Enter drücken)—markiere gleich Tabelle 1, Zelle D2 (drücke Enter)— setzte Maus an das Rechte untere Eck von Zelle D1, Tabelle 2— Maus wird zum dünnen Kreuz—zieh nun mit gedrückter linker Maustaste bis Zelle A100(markieren), lass wieder los, Enter— Jetzt werden immer wenn du in Tabelle 1, Spalte D einen Wert in den Zellen D1 bis D100 eingibst, sofort die Werte in Tabelle 2, Spalte D, Zelle D1 bis D100 übergeben. Sortieren ist dann nur noch Kinderfasching. Gehe Tabelle 2, markiere Zelle D1 jetzt einfach auf sortieren drücken (Schau mal auf deine Excel Menüs, da muss irgendwo ganz groß Sortieren stehen). Fertig.Viel Spaß noch.
Hallo
Versuche es mal mit dem SVERWEIS (zur not mal in der Excel hilfe nachschauen)
dafür musst du zwar die Tabelle ein wenig anpassen, funktioniert dann aber tadellos.
liebe Grüße
Stephan