Programmieren fürs Praktikum. Brauche bitte Hilfe

Hallo Liebe Excel Könner,
ich bin gerade im Praktikum und muss so einiges für Excel machen, ua. für folgenden Sachverhalt bräuchte ich ein Makro:
Gegeben ist ein Datensatz mit 7 Spalten. In der ersten Spalte wird die Projektnummer angegeben, welche sich wiederholen kann (dazu mehr gleich) und dreistellig wird.
In der zweiten Spalte steht die Vorgangsnummer (aufsteigend). Pro Projekt finden natürlich mehrere Vorgänge statt daher wiederholen sich auch die Projektnummer in der ersten Spalte.
Das Makro sollte nun aus dem Datensatz, für jedes Projekt jene Zeile mit dem aktuellsten Vorgang ( also mit der größten Vorgangsnummer) kopieren und in "Tabelle 2" als neuen Datensatz auflisten.
Falls Ihr etwas hierzu habt, wäre ich euch soo Dankbar. Auch "links" würden mir extrem weiterhelfen.
Danke schon mal und Viele Grüße
Jo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
kannst ja mal testen.
Es wird mit eine Hilfsspalte gearbeitet, diese wird wieder gelöscht.

Sub Makro1()
Dim Bereich As Range, MerkBereich As Range
Dim Ziel As Range
Dim iCalc As Integer


'Quelle wenn mit Überschrift, sonst nur Usedrange 
Set Bereich = Sheets("Tabelle1").UsedRange.Offset(1, 0)

'wo Daten hin sollen 
Set Ziel = Sheets("Tabelle2").Range("A2")



With Application
  iCalc = .Calculation
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
        
        'Ziel leer machen 
        With Sheets(Ziel.Parent.Name)
         .Range(Ziel, .Cells(.Rows.Count, 7)).Value = ""
        End With
        
        With Bereich
            .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 2), Order2:=xlDescending, Header:=xlNo
         
            With .Columns(.Columns.Count).Offset(0, 1)
              Set MerkBereich = Union(Bereich, Bereich.Offset(0, 1))
             .FormulaR1C1 = "=IF(AND(RC1<>R[-1]C1,RC1<>""""),TRUE,"""")"
              MerkBereich.Offset(1, 0).Sort Key1:=.Cells(1, 1), Order1:=xlAscending
             .Value = .Value
             On Error Resume Next
              Set MerkBereich = .SpecialCells(xlCellTypeConstants).EntireRow
             On Error GoTo 0
              .Value = ""
              MerkBereich.Copy Ziel 'wo Daten hin sollen 
              .EntireColumn.Delete
            End With
          
          .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 2), Order2:=xlDescending, Header:=xlNo
        End With

 .ScreenUpdating = True
 .Calculation = iCalc
End With
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Programmieren fürs Praktikum. Brauche bitte Hilfe

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread