Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1136to1140
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1136to1140
1136to1140
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro Daten dezimieren

Makro Daten dezimieren
ChF
Guten Morgen zusammen,
ich habe folgendes Problem:
ich möchte die Datenmenge einer externen Aufzeichnung reduzieren. Es handelt sich aber dabei immer um eine unterschidlich große Datenmenge, d.h. unterschiedlich viele Zeilen und Spalten.
Mit einem Makro sollen nun immer 10 Zeilen gelöscht werden und die nächsten 10 Zeilen sollen dann erhalten bleiben usw., solange bis keine Daten mehr vorhanden sind.
Ich hoffe ich hab das Problem einigermaßen verständlich beschrieben.
Danke für die Hilfe

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
was für eine externe Aufzeichnung?
17.02.2010 09:17:00
Tino
Hallo,
von was sprichst Du?
Von einer Text- Datei oder von einem Excel- Datei?
Gruß Tino
AW: was für eine externe Aufzeichnung?
17.02.2010 09:25:58
ChF
Hallo Tino,
es sind Excel-Daten die in das File kopiert werden.
Grüße
AW: was für eine externe Aufzeichnung?
17.02.2010 09:48:32
Tino
Hallo,
hier mal eine Version zum testen.
Tabellennamen noch anpassen.
Sub Makro1()
Dim oSH As Worksheet
Dim iCalc As Integer
Set oSH = Sheets("Tabelle1")

With Application
     iCalc = .Calculation
     .Calculation = xlCalculationManual
     .ScreenUpdating = False
     
        With oSH.UsedRange
            With .Columns(.Columns.Count).Offset(0, 1)
                .FormulaR1C1 = "=IF(OR(MOD(ROW(R[-" & .Cells(1, 1).Row - 1 & "]C1),20)>10," & _
                               "MOD(ROW(R[-" & .Cells(1, 1).Row - 1 & "]C1),20)=0),TRUE,ROW())"
                oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                .EntireColumn.Delete
                On Error GoTo 0
            End With
        End With
    
    .Calculation = iCalc
    .ScreenUpdating = True
End With
End Sub
Gruß Tino
Anzeige
AW: Makro Daten dezimieren
17.02.2010 09:32:16
fcs
Hallo ChF,
funktioniert z.B. mit folgendem Makro.
Voraussetzung: in der für das löschen der leeren Zeilen gewählten Spalte (hier 1 bzw. A) sind in allen Zeilen Werte eingetragen.
Gruß
Franz 
Sub LoeschenTeilweise()
Dim Zeile As Long, wks As Worksheet, CalcStatus As Long
Dim Delta As Long
Const Spalte As Long = 1 'Spalte in der alle Zeilen ausgefüllt sind
Delta = Application.InputBox(Prompt:="Anzahl Zeilen pro Block", _
Title:="Zeilen in Blöcken löschen?", _
Default:=10, Type:=1)
If Delta > 0 Then
Set wks = ActiveSheet
Application.ScreenUpdating = False
CalcStatus = Application.Calculation
If Application.Calculation  xlCalculationManual Then
Application.Calculation = xlCalculationManual
End If
With wks
For Zeile = Delta + 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row Step Delta * 2
.Range(.Rows(Zeile), .Rows(Zeile + Delta - 1)).ClearContents
Next Zeile
.Columns(Spalte).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
End With
Application.ScreenUpdating = True
If Application.Calculation  CalcStatus Then
Application.Calculation = CalcStatus
End If
End If
End Sub

Anzeige
AW: Makro Daten dezimieren
17.02.2010 10:03:59
Reinhard
Hallo Chf, 

Sub loesch()
Dim Zei As Long, Z As Long
Zei = Cells(Rows.Count, 1).End(xlUp).Row
Range("H1:H" & Zei).FormulaLocal = "=wenn(rest(ganzzahl((zeile()-1)/10);2)=1;1;"""")"
Range("H1:H" & Zei).Value = Range("H1:H" & Zei).Value
Range("A1:H" & Zei).Sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1:H" & Application.Sum(Range("H:H"))).Delete
Range("H:H").Delete
End Sub

Gruß
Reinhard
AW: Makro Daten dezimieren
17.02.2010 10:18:39
ChF
Hallo zusammen,
vielen Dank für eure schnelle Hilfe, die Makros funktionieren einwandfrei.
Hab jetzt bloß die Qual der Wahl welches ich verwende.
Schöne Grüße
ChF
Anzeige
AW: Makro Daten dezimieren
17.02.2010 10:50:28
ChF
Nochmal eine Kurze Frage:
kann man das Makro auch dahingehend ändern, so dass nur 1 Zeile stehen bleibt und dann 10 gelöscht
werden und dann wieder eine Zeile stehen bleibt usw. oder wie bei der Lösung von Reinhard die Anzahl eingegeben werden kann?
Danke
ChF
AW: Zeilen dynamisch dezimieren
17.02.2010 15:19:22
Renee
Hi ChF,
ich hab jetzt einfach mal fcss Code ein bisschen modifiziert: 
Sub LoeschenTeilweise()
Dim Zeile As Long, wks As Worksheet, CalcStatus As Long
Dim Delta As String, Delta1 As Long, Delta2 As Long
Const Spalte As Long = 1 'Spalte in der alle Zeilen ausgefüllt sind
Delta = Application.InputBox(Prompt:="# Zeilen bleiben, # Zeilen löschen", _
Title:="Zeilen löschen?", _
Default:="10,10", Type:=2)
On Error Resume Next
If Delta > 0 Then
On Error GoTo 0
Set wks = ActiveSheet
Application.ScreenUpdating = False
CalcStatus = Application.Calculation
If Application.Calculation  xlCalculationManual Then
Application.Calculation = xlCalculationManual
End If
Delta1 = CLng(Split(Delta, ",")(0))
Delta2 = CLng(Split(Delta, ",")(1))
If Delta1 = 0 Or Delta2 = 0 Then
MsgBox "Falsche Eingabe!"
Exit Sub
End If
With wks
For Zeile = Delta1 + 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row Step (Delta1 +  _
Delta2)
.Range(.Rows(Zeile), .Rows(Zeile + Delta2 - 1)).ClearContents
Next Zeile
.Columns(Spalte).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
End With
Application.ScreenUpdating = True
If Application.Calculation  CalcStatus Then
Application.Calculation = CalcStatus
End If
End If
End Sub

GreetZ Renée
Anzeige
AW: Zeilen dynamisch dezimieren
18.02.2010 12:59:38
ChF
Super, Danke.
Funktioniert wie ich mir es vorgestellt habe.

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige