Microsoft Excel

Herbers Excel/VBA-Archiv

Automatisierung mit Hilfe VBA | Herbers Excel-Forum


Betrifft: Automatisierung mit Hilfe VBA von: Becker
Geschrieben am: 08.02.2012 22:05:26

Hallo liebe Excel Gemeinde,

Möchte gerne mit Hilfe Makro folgendes Problem lösen; täglich bekomme ich einige Berichte nach Excel exportiert die ich dementsprechend bearbeiten muss um ein gezieltes Ergebnis zu haben. Es handelte sich um ein paar hunderte von Zeilen pro Excel Bericht.

Von Zeilen A1 bis D8 sind Kopf Zeilen. Variable Daten Berichten sind von A8:D….250 oder 388 oder 423 (von A8:A…ohne leere Zeilen). Daten von B8:C…. haben zwischen jeden Mitarbeiter eine Leere Zeile. Daten von "E8:E..." haben auch keine leere Zeilen. Habe eine Beispiel Mappe mit 2 Tabellen Blätter. Tabellen Blatt „Vorher“ es handelt sich hier um originalen Export Bericht und Tabelle „Nachher“ ist eine Beispiels Datei wie es aussehen sollte.

https://www.herber.de/bbs/user/78808.xls


Mein selbst aufgezeichnetes Makro:

 
Sub Makro1()
'
' Makro1 Makro
' test
'

'
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 37.57
    Range("B8").Select
    Selection.Cut
    Range("A9").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A9:A12"), Type:=xlFillDefault
    Range("A9:A12").Select
    Range("B13").Select
    Selection.Cut
    Range("A14").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A14:A18"), Type:=xlFillDefault
    Range("A14:A18").Select
    Range("B19").Select
    Selection.Cut
    Range("A20").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A20:A23"), Type:=xlFillDefault
    Range("A20:A23").Select
    Range("B24").Select
    Selection.Cut
    Range("A25").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A25:A28"), Type:=xlFillDefault
    Range("A25:A28").Select
    Range("B29").Select
    Selection.Cut
    Range("A30").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A30:A33"), Type:=xlFillDefault
    Range("A30:A33").Select
    Range("B34").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=9
    Range("A35").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A35:A39"), Type:=xlFillDefault
    Range("A35:A39").Select
    Range("B40").Select
    Selection.Cut
    Range("A41").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=6
    Selection.AutoFill Destination:=Range("A41:A43"), Type:=xlFillDefault
    Range("A41:A43").Select
'....usw. von  zum ersten "E" leeren Spalten....
End Sub

So wie kann man Makro automatisieren(bezogen auf Blatt „Nachher“):
-wenn ich Makro starte (in active sheet) er soll zuerst eine Spalte einfügen(Spalte „A“)
-dann solle er nur die Mitarbeiter Namen (die gibt’s viele) aus Spalte „B“ nach Spalte „A“ schreiben
-alle Mitarbeiter Namen haben große Buchstaben
-zwischen jeden neuen Mitarbeiter gibt es immer eine leere „C“ Spalte, siehe bitte Tabellen Beispiel „Nachher“ und in Zeilen von „E8:E…. bis zum letzten gefüllten Zeilen sind immer Daten (Ohne leere Zeilen)

Ich hoffe dass ich mein Anliegen verständlich beschrieben habe.

Vielen Dank für jeder kommende Hilfe

Gruß

Daniel

  

Betrifft: AW: Automatisierung mit Hilfe VBA von: Martin MJ
Geschrieben am: 10.02.2012 19:05:04

Hi Daniel

ich habe dir mal was gebastlt... mit VBA

hier ist der code und eine Beispieldatei... da ist dieser code enthalten ;-))
Du kannst ihn mit [Strg+q] starten. Ich habe dir auch ein Tabellenblatt eingefügt "Test" dort kannst Du das Programm testen...

https://www.herber.de/bbs/user/78848.xls

Gruß Martin MJ

Sub format()

Dim Name As String
Dim maxZeile As Long
Dim Sprung As Long

maxZeile = Range("B1").SpecialCells(xlCellTypeLastCell).Row ' speichert die letzte belegte  _
Zeile in Spalte B
Columns(1).Select
Selection.Insert Shift:=xlToRight ' fügt eine Spalte vor Spalte A ein

Name = Cells(8, 2).Value 'speichert den ersten Namen
Cells(8, 2).ClearContents 'löscht den ersten Namen aus Spalte B
For a = 9 To maxZeile 'schleifen beginn ( große Schleife )
    If Len(Cells(a, 3)) > 0 Then ' beginn kleine schleife)
        Cells(a, 1).Value = Name
    Else
        Name = Cells(a, 2).Value
        Cells(a, 2).ClearContents 'löscht den Namen aus Spalte B
    End If 'ende kleine Schleife
    
Next a 'Ende Große Schleife, wenn a = maxZeile
Columns("A:A").EntireColumn.AutoFit 'optimale Spaltenbreite für Spalte A
Range("A1").Select
End Sub



  

Betrifft: AW: Ergänzung zur Lösung von Martin von: fcs
Geschrieben am: 11.02.2012 09:02:22

Hallo Daniel,


ich hätte noch ein paar Ergänzungen zu Martin's Vorschlag.
1. Bildschirmaktualisierung während der Makroausführung deaktivieren
2. Spaltentitel in Spalte A eintragen
3. Fenster unter Spaltentiteln fixieren.
4. Autofilterbereich anpassen

Gruß
Franz

Sub format()

Dim Name As String
Dim maxZeile As Long
Dim Sprung As Long

maxZeile = Cells(Rows.Count, 2).End(xlUp).Row ' speichert die letzte belegte Zeile in Spalte B
Application.ScreenUpdating = False
Columns(1).Select
Selection.Insert Shift:=xlToRight ' fügt eine Spalte vor Spalte A ein

'Spaltentitel eintragen in Spalte A
Cells(7, 1).Value = Cells(6, 2).Text

Name = Cells(8, 2).Value 'speichert den ersten Namen
Cells(8, 2).ClearContents 'löscht den ersten Namen aus Spalte B
For a = 9 To maxZeile 'schleifen beginn ( große Schleife )
    If Len(Cells(a, 3)) > 0 Then ' beginn kleine schleife)
        Cells(a, 1).Value = Name
    Else
        Name = Cells(a, 2).Value
        Cells(a, 2).ClearContents 'löscht den Namen aus Spalte B
    End If 'ende kleine Schleife
    
Next a 'Ende Große Schleife, wenn a = maxZeile
Columns("A:A").EntireColumn.AutoFit 'optimale Spaltenbreite für Spalte A
'Fenster fixieren
ActiveWindow.ScrollRow = 1
Range("A8").Select
ActiveWindow.FreezePanes = True

'Autofilterbereich neu setzen

With ActiveSheet
  If .AutoFilterMode = True Then
    .AutoFilterMode = False
  End If
  .Range(.Cells(7, 1), .Cells(maxZeile, 5)).AutoFilter
End With

Application.ScreenUpdating = True
End Sub



  

Betrifft: AW: Ergänzung zur Lösung von Martin von: Martin Mj
Geschrieben am: 11.02.2012 12:06:55

Hi Franz, gute Ergänzung... Danke. ;-))



LG Martin


  

Betrifft: AW: Ergänzung zur Lösung von Martin von: Martin Mj
Geschrieben am: 11.02.2012 12:06:56

Hi Franz, gute Ergänzung... Danke. ;-))



LG Martin


  

Betrifft: AW: Ergänzung zur Lösung von Martin von: Martin Mj
Geschrieben am: 11.02.2012 12:06:59

Hi Franz, gute Ergänzung... Danke. ;-))



LG Martin


  

Betrifft: UPS... Sorry ;-) von: Martin Mj
Geschrieben am: 11.02.2012 12:10:00

UPS... Da hab ich wohl ein bischen oft geklickt. ;-)) Sorry


  

Betrifft: SUPER DANKE - AW: UPS... Sorry ;-) von: Becker
Geschrieben am: 11.02.2012 15:08:32

Hallo Martin und Franz,

dank Euer Hilfe es FUNKTIONIERT, WAU TAUSEND MAL DANK.
Das wird mir mein Arbeitstag um einiges erleichtern.

El-forum-Herber ist ein sehr gutes Forum Dank Euch Profis.

Danke Danke

Daniel