19.2k Aufrufe
Gefragt in WindowsXP von exceluser91 Mitglied (103 Punkte)
Hallo und feinen Nachmittag zusammen,

ich bin derzeit in der Arbeit als Werkstudent mit einem Project involviert.
Excel!

Um einen schnelleren Arbeitsfluss zu ermöglichen, sollten manche Vorgänge per Makros funktionieren..
Jetzt zu der Aufgabe und ich hoffe ihr könnt mir helfen sonst, bin ich verloren^^

1. Jedes Monat werden aus einer txt datei ( monatl. wird eine neue txt datei angelegt) die Daten in eine Excel-datei eingelesen.
kann man dafür ein Makro erstellen?


2. Die Lasche "Tabelle 1" sollte sich per Makro in "Reichweite" umändern lassen, ebenso sollte gleichzeitig dann eine neue Lasche mit Titel "Summe" zusätzlich hinzugefügt werden.

3, Per Makro: Aus der oben genannten txt (oder aus der fertig importierten) müssen dann, alle Zeilen ausgeschnitten, welche in der Spalte C "Summe" stehen haben und in das erstellte Tabellenblatt "Summe" eingefügt werden.

4. Per Makro würde ich dann gerne alle leeren Zeilen, sowie Zeilen
welche doppelt genannt werden löschen, außer in der ersten Zeile, Quasi eine Doppelnennung dieser Zeile vermeiden!

Test Inventur: Reichweiten-/Abwertsatzermittlung 02.10.2012 10:59:25 Seite: 2

das 5. und letzte Makro

a)Spalte einfügen in das erste Tabellenblatt mit dem Namen "Dispo_Name"
b) Spalte löschen WFG


Ob mir hier jmd helfen kann, das wäre der Knüller!
Leider habe ich erst ab kommenden März eine Excel spezifische Weiterbildung in meiner Uni.. und leisten kann ich Sie mir bis dato schwer!
Vielen vielen Dank im voraus und ich freue mich über jede produktive Antwort!

Viele Grüße
Ben

81 Antworten

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benjamin,

versuch mal, ob der folgende Code nun so klappt, wie du willst:

Sub kopieren_loeschen_neu2()

Dim anfang, ende, zeile, lzeile, szeile As Integer

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte Zeile im aktiven Arbeitsblatt "Reichweite" ermitteln
lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Anfang des zu kopierenden Bereichs suchen: zwei Zeilen untereinander mit ---
For zeile = 6 To lzeile
If Left(ActiveSheet.Cells(zeile, 1).Value, 1) = "-" And Left(ActiveSheet.Cells(zeile - 1, 1).Value, 1) = "-" Then
anfang = zeile + 1
Exit For
End If
Next zeile

For zeile = 6 To lzeile
'Gesamtsumme
If Left(ActiveSheet.Cells(zeile, 3).Value, 11) = "Gesamtsumme" Then
ende = zeile
Exit For
End If
Next zeile

'gefundenen Bereich kopieren
ActiveSheet.Range(Cells(anfang, 1), Cells(ende, 1)).EntireRow.Copy Destination:=Worksheets("Summe").Cells(6, 1)

For zeile = lzeile To 6 Step -1
'Zeile mit VD suchen und kopieren
If Left(ActiveSheet.Cells(zeile, 9).Value, 2) = "VD" Then
ActiveSheet.Cells(zeile, 1).EntireRow.Copy Destination:=Worksheets("Summe").Cells(6 + ende - anfang + 1, 1)
szeile = szeile + 1
End If
Next zeile

'Nun alle nicht benötigten Zeilen löschen
'Löschen von rückwärts
For zeile = lzeile To 6 Step -1
'alle Zeilen, die hinter Gesamtsumme stehen werden gelöscht
If zeile >= ende Then ActiveSheet.Rows(zeile).Delete

'Alle Zeilen mit Summe löschen
If Left(ActiveSheet.Cells(zeile, 3).Value, 5) = "Summe" Then ActiveSheet.Rows(zeile).EntireRow.Delete

'leere Zeilen löschen
With ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 19))
If Application.WorksheetFunction.CountBlank(.Cells) = .Cells.Count Then
Rows(zeile).EntireRow.Delete
End If
End With

'Zeilen, die mit - beginnen werden gelöscht
If Left(ActiveSheet.Cells(zeile, 1).Value, 1) = "-" Then ActiveSheet.Rows(zeile).EntireRow.Delete

'Zellen in denen in Spalte A keine Zahl steht werden gelöscht
If Not IsNumeric(ActiveSheet.Cells(zeile, 1)) Then ActiveSheet.Rows(zeile).EntireRow.Delete

'Zellen mit Leerzeichen in Spalte A werden gelöscht
If IsNumeric(ActiveSheet.Cells(zeile, 1)) And ActiveSheet.Cells(zeile, 1).Value = 0 Then ActiveSheet.Rows(zeile).EntireRow.Delete

Next zeile

'Spalte 2 mit WFG löschen
Sheets("Summe").Columns(2).Delete Shift:=xlToLeft

'Im Blatt Summe alle Zeilen löschen, die mit - anfagen
For zeile = 6 To Worksheets("Summe").UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Left(Worksheets("Summe").Cells(zeile, 1).Value, 1) = "-" Then Worksheets("Summe").Rows(zeile).EntireRow.Delete
Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Gruß

M.O.
0 Punkte
Beantwortet von exceluser91 Mitglied (103 Punkte)
Na das funktioniert ja jetzt super!
nur ist zwischen den summen jetzt nur noch
A2P:Z0MIN110 Inventur: Reichweiten-/Abwertsatzermittlung 02.10.2012 10:59:25 Seite: 193
Dis


diese überschriften und -----


wäre aber nicht so schlimm wenn du das nicht rausbekommen würdest!
das kann man auch manuell machen, sind nur 3-4 x

aber ansonsten, finde ich es super klasse wie du dich hier um mein Problem gekümmert hast!
Vielen lieben Dank M.O.
0 Punkte
Beantwortet von exceluser91 Mitglied (103 Punkte)
ah und es beginnt in zeile 5, dort wird es eingefuegt, geht da auch zeile 1?
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benjamin,

ich seh' mal, was ich machen kann ;-)

Gruß

M.O.
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benjamin,

schau mal, ob es es so funktioniert, wie du willst:

Sub kopieren_loeschen_neu3()

Dim anfang, ende, zeile, lzeile, szeile As Integer

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte Zeile im aktiven Arbeitsblatt "Reichweite" ermitteln
lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Anfang des zu kopierenden Bereichs suchen: zwei Zeilen untereinander mit ---
For zeile = 6 To lzeile
If Left(ActiveSheet.Cells(zeile, 1).Value, 1) = "-" And Left(ActiveSheet.Cells(zeile - 1, 1).Value, 1) = "-" Then
anfang = zeile + 1
Exit For
End If
Next zeile

For zeile = 6 To lzeile
'Gesamtsumme
If Left(ActiveSheet.Cells(zeile, 3).Value, 11) = "Gesamtsumme" Then
ende = zeile
Exit For
End If
Next zeile

'gefundenen Bereich kopieren
ActiveSheet.Range(Cells(anfang, 1), Cells(ende, 1)).EntireRow.Copy Destination:=Worksheets("Summe").Cells(1, 1)

For zeile = lzeile To 6 Step -1
'Zeile mit VD suchen und kopieren
If Left(ActiveSheet.Cells(zeile, 9).Value, 2) = "VD" Then
ActiveSheet.Cells(zeile, 1).EntireRow.Copy Destination:=Worksheets("Summe").Cells(6 + ende - anfang + 1, 1)
szeile = szeile + 1
End If
Next zeile

'Nun alle nicht benötigten Zeilen löschen
'Löschen von rückwärts
For zeile = lzeile To 6 Step -1
'alle Zeilen, die hinter Gesamtsumme stehen werden gelöscht
If zeile >= ende Then ActiveSheet.Rows(zeile).Delete

'Alle Zeilen mit Summe löschen
If Left(ActiveSheet.Cells(zeile, 3).Value, 5) = "Summe" Then ActiveSheet.Rows(zeile).EntireRow.Delete

'leere Zeilen löschen
With ActiveSheet.Range(Cells(zeile, 1), Cells(zeile, 19))
If Application.WorksheetFunction.CountBlank(.Cells) = .Cells.Count Then
Rows(zeile).EntireRow.Delete
End If
End With

'Zeilen, die mit - beginnen werden gelöscht
If Left(ActiveSheet.Cells(zeile, 1).Value, 1) = "-" Then ActiveSheet.Rows(zeile).EntireRow.Delete

'Zellen in denen in Spalte A keine Zahl steht werden gelöscht
If Not IsNumeric(ActiveSheet.Cells(zeile, 1)) Then ActiveSheet.Rows(zeile).EntireRow.Delete

'Zellen mit Leerzeichen in Spalte A werden gelöscht
If IsNumeric(ActiveSheet.Cells(zeile, 1)) And ActiveSheet.Cells(zeile, 1).Value = 0 Then ActiveSheet.Rows(zeile).EntireRow.Delete

Next zeile

'Spalte 2 mit WFG löschen
Sheets("Summe").Columns(2).Delete Shift:=xlToLeft

'Im Blatt Summe alle Zeilen löschen, die mit -, A, D oder S anfagen
For zeile = Worksheets("Summe").UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Left(Worksheets("Summe").Cells(zeile, 1).Value, 1) = "-" Then Worksheets("Summe").Rows(zeile).EntireRow.Delete
If Left(Worksheets("Summe").Cells(zeile, 1).Value, 1) = "A" Then Worksheets("Summe").Rows(zeile).EntireRow.Delete
If Left(Worksheets("Summe").Cells(zeile, 1).Value, 1) = "D" Then Worksheets("Summe").Rows(zeile).EntireRow.Delete
If Left(Worksheets("Summe").Cells(zeile, 1).Value, 1) = "S" Then Worksheets("Summe").Rows(zeile).EntireRow.Delete
Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Gruß

M.O.
0 Punkte
Beantwortet von exceluser91 Mitglied (103 Punkte)
Ich denke jetzt hast du es gleich optimal geschafft,
2 kleine Störfaktoren sind noch drin, wenn du sie nicht beheben kannst, kein Problem!

zum einen sind noch Zeilen drin, wo die ersten 4 spalten leer sind und ab "I"
steht dann AS HB.vor Abschr Abwertung TR AS EWB Abwertung

und die erste Zeile so es losgeht mit der Nummerierung in der Lasche Reichweite wird komischerweise immer 6 Zeilen unter die Gesamtsumme in der Lasche Summe mit reinkopiert,(gehoert aber nicht zu den Summen ganz unten, da in der 2. spalte dann matrialnummer usw steht. is also wirklich die oberste Zeile nach der Überschrift usw:

701 6GK15000AA10 BUSTERMINAL 12M
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benjamin,

bei deiner Beispieltabelle klappt das Makro. Wie ich schon geschrieben habe, kann ich das Makro nur anhand deiner Beispieltabelle schreiben. Weicht diese von der Orginaldatei ab, so kann es zu anderen Ergebnissen bei dem Orginal kommen.

Die Zeilen zu löschen , in denen in Spalte I "AS" steht, dürfte kein Problem sein. In deiner Beispieltabelle steht das jedoch in Spalte J.
Ist es also wirklich die Spalte I ? Und steht bei den zu kopierenden Summen auch etwas in der Spalte I (oder eben J)?

Mit Lasche meinst du Tabelle :-). Warum nun eine unerwünschte Zeile aus der Tabelle Reichweite kopiert wird, kann ich nicht sagen. Steht da vielleicht in Spalte H "VD" drin?

Gruß

M.O.
0 Punkte
Beantwortet von exceluser91 Mitglied (103 Punkte)
Hi,

ja zum einen müsste normal J zu I werden, da wir ja spalte WFG löschen

und in der spalte I steht VD drin in dieser komischerweise mitkopierten Zeile :)
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benjamin,

steht bei den zu kopierenden Summen auch etwas in der Spalte I (oder eben J) oder ist die Spalte hier leer?

Gruß

M.O.
0 Punkte
Beantwortet von exceluser91 Mitglied (103 Punkte)
in I nicht immer "J" scheint mir leer zu sein
...