Hallo zusammen,
ich bin benötig ein Makro, welches bestimmte Zellen aus einer Zeile in ein anderes Registerblatt kopiert, nur wenn in Spalte F oder Spalte G ein "X" steht
[
attachment=48038]
[
attachment=48039]
Wenn nach dem Ausführen des Markros neue Zeilen im Registerblatt "Daten" mit "X" gekennzeichnet werden, soll die neue Zeile unten angehängt werden und die schon übernommenen Werte nicht angetastet werden (zweites Makro). Maximale auszulesende Zeilen sind 100.
Ich sag schon mal Danke für eure Anregungen.
Lines
(04.05.2023, 10:16)Lines schrieb: [ -> ]Ich sag schon mal Danke für eure Anregungen.
"Anregungen", nein Komplettlösungen, findet man zu diesem ausgelatschten Thema doch zuhauf im Netz. Es klingt daher eher, du erwartest eine Komplettlösung. Also: Warum bist du nicht ehrlich und fragst nach einer Komplettlösung?
Zitat:wer fragt, gilt [...] als dumm...
"faul" ist korrekt. Was meinst du, was man erst lernen kann, wenn man anfängt, sowas selbst hinzubekommen?
Für Code 2, wobei ich Code 1 für sinnlos erachte, du wirst dahinterkommen.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim out As Worksheet: Set out = Worksheets("Auswertung")
Dim lngNewRow As Long
Dim c As Range
If Not Intersect(Target, Me.Range("F:G")) Is Nothing Then
For Each c In Intersect(Target, Me.Range("F:G"))
If LCase(c.Value) = "x" Then
If IsError(Application.Match(Me.Cells(c.Row, 1).Value, out.Range("A:A"), 0)) Then
With out
lngNewRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngNewRow, 1).Value = Me.Cells(c.Row, 1).Value
.Cells(lngNewRow, 2).Value = Me.Cells(c.Row, 2).Value
.Cells(lngNewRow, 3).Value = Me.Cells(c.Row, 3).Value
.Cells(lngNewRow, 4).Value = Me.Cells(c.Row, 8).Value
End With
End If
End If
Next c
End If
End Sub
(04.05.2023, 10:42)EarlFred schrieb: [ -> ]"Anregungen", nein Komplettlösungen, findet man zu diesem ausgelatschten Thema doch zuhauf im Netz. Es klingt daher eher, du erwartest eine Komplettlösung. Also: Warum bist du nicht ehrlich und fragst nach einer Komplettlösung?
"faul" ist korrekt. Was meinst du, was man erst lernen kann, wenn man anfängt, sowas selbst hinzubekommen?
Für Code 2, wobei ich Code 1 für sinnlos erachte, du wirst dahinterkommen.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim out As Worksheet: Set out = Worksheets("Auswertung")
Dim lngNewRow As Long
Dim c As Range
If Not Intersect(Target, Me.Range("F:G")) Is Nothing Then
For Each c In Intersect(Target, Me.Range("F:G"))
If LCase(c.Value) = "x" Then
If IsError(Application.Match(Me.Cells(c.Row, 1).Value, out.Range("A:A"), 0)) Then
With out
lngNewRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngNewRow, 1).Value = Me.Cells(c.Row, 1).Value
.Cells(lngNewRow, 2).Value = Me.Cells(c.Row, 2).Value
.Cells(lngNewRow, 3).Value = Me.Cells(c.Row, 3).Value
.Cells(lngNewRow, 4).Value = Me.Cells(c.Row, 8).Value
End With
End If
End If
Next c
End If
End Sub
Hallo EarlFred,
du hast völlig recht, ich bin zu sehr im Stress um Anregungen umzusetzen und möchte eine Lösung.
Ich schau mir nachher an was du vorgeschlagen hast.
Danke
Moin,
mit einer Hilfsspalte schafft der Autofilter das auch problemlos.
Viele Grüße
derHöpp
Kommt ein Kollege zu mir mit einem Excelproblem. Ich "hab ich auch keine Ahnung, kenne aber ein Forum in dem ich fragen kann"...
Fehler von mir das ich dachte es sei der Sinn dieses (jedes?) Forums nach Hilfe zu fragen wenn man keine Ahnung von einem Thema hat.
Ich hab beruflich nicht die Zeit mich hinzusetzen und VBA/Query und co. zu lernen, meine Kompetenzen liegen woanders.
Ergebnis: Blöd angemacht wurden mit einer (bei mir?) nicht funktionierenden Lösung
und einem freundlichen Hinweis auf Query (Dafür Danke PIVPQ) per PN.
Hilfsspalte und Autofilter kommen nicht in Frage.
Hat noch jemand eine sachliche Lösung für mich?
Forum = Kostenloser Programmierservice? Ist das dein Ernst? Falsch gedacht! Ich kann nicht mit einer Bohrmaschine umgehen? Frag ich doch in einem Forum, da kommt dann einer zu mir und werkelt kostenlos? Sag mal: Gehts noch? Schuss nicht gehört?
Und dann bekommst du eine funktionierende Lösung, heulst aber rum, dass du böse behandelt wirst und außer der Lüge, es funktioniere alles nicht, bekommt man keine verwertbare Aussage? Ich bereue es, mich mit deinem Problem beschäftigt zu haben! Wa für eine verabscheuenswürdige und widerwärtige Anspruchshaltung, was bist du für ein Mensch, für den selbst kostenlos noch zu teuer ist? Scher dich zum Teufel!
Hallo Lines,
also der VBA-Code von EarlFred funktioniert bei mir in deiner Beispieldatei perfekt.
(Wie) hast du den Code ausprobiert ?
Wo hast du ihn eingefügt ?
Das ist ein Ereignismakro, das durch Änderungen im jeweiligen Tabellenblatt ausgelöst wird und gehört in das Codemodul von Tabellenblatt "Daten".
(Rechtsklick auf Tabellenblattregister "Daten" -> Code anzeigen)
https://www.online-excel.de/excel/singsel_vba.php?f=44
Wenn in Spalte F oder G ein x eingetragen wird, werden die Werte dieser Zeile automatisch in das Tabellenblatt "Auswertung" übertragen.
Eine weitere Anregung:
verwende eine Formellösung.
in neueren Excelversionen (Excel 2021, Office 365) gäbe es hierfür die Funktion FILTER.
In älteren Excelversionen geht es (etwas aufwendiger) mit der INDEX/AGGREGAT-Formel
Erklärung der Formel siehe hier:
https://www.youtube.com/watch?v=He3dblboncw
| Arbeitsblatt mit dem Namen 'Auswertung' |
| A | B | C | D |
| 1 | Beispiel_Nr. | Daten_1 | Daten_2 | Daten_7 |
| 2 | 1 | a_1 | a_2 | a_7 |
| 3 | 3 | c_1 | c_2 | c_7 |
| 4 | 4 | d_1 | d_2 | d_7 |
| 5 | 7 | g_1 | g_2 | g_7 |
| Zelle | Formel |
| A2 | =WENNFEHLER(INDEX(Daten!$A$2:$A$39;AGGREGAT(15;6;ZEILE(Daten!$A$2:$A$39)/(Daten!$F$2:$G$40="x")-1;ZEILE(A1)));"") |
| B2 | =WENN(A2<>"";SVERWEIS(A2;Daten!$A$2:$H$40;2;0);"") |
| C2 | =WENN(A2<>"";SVERWEIS(A2;Daten!$A$2:$H$40;3;0);"") |
| D2 | =WENN(A2<>"";SVERWEIS(A2;Daten!$A$2:$H$40;8;0);"") |
| Verwendete Systemkomponenten: [Windows (64-bit) NT 10.00] / MS Excel 2021 |
| Diese Tabelle wurde mit Tab2Html (v2.7.1) erstellt. ©Gerd alias Bamberg |
Gruß
Fred