Excel: Makro erstellen

birnchen

back to the roots
ID: 134652
L
21 April 2006
11.225
1.155
moinsen,

ich hab da nen kleines problemchen. und zwar habe ich mehrere datentabellen mit etwa 3000 werten. jetzt möchte ich daraus ne kurve machen, allerdings sollen da die datenpunkte nicht als linie zu sehen sein, sondern als einzelne punkte. da es dafür aber zu viele daten sind, möchte ich die daten ausdünnen, dh. ich brauche nen makro, mit dem ich das machen kann. wir hatten da mal eins, das leider nicht mehr funktioniert. das ging in etwa so: du hast einen parameter n, der gibt an, wieviele durchläufte gemacht werden sollen. bei jedem durchlauf wird immer der 2. oder 3. wert gelöscht und nach n durchläufen sind dann von den 3000 daten noch 3000-x daten übrig. ich will das n dann so einstellen können, daß ich so viele durchläufe machen kann, bis es halt paßt.

kann mir da jemand helfen?

grüß
birnchen
 
Nehm dir halt einfach ein so ein Makro auf :)
Müsste theoretisch funktionieren, wenn du Aufnahme drückst und dann immer mit den Pfeiltasten 2 Zeilen runtergehst und einmal Zeile löschen ausführst.
Das legst dir dann auf ne Tastenkombination und hältst die einfach mal n bisschen gedrückt, bis du unten bist.

Für ne saubere Lösung müsstest du ne VB-Prozedur schreiben.
Wenn ich nachmittags Zeit hab, dann guck ich mal, ob ich dir was basteln kann ;)
 
Guck dir die mal an:
:arrow: www.thehacker.ws/dummy/birnchendummy.xls

Hier mal der Code, wer auch lesen will:
PHP:
Sub Schaltfläche1_BeiKlick()
  Dim Sheet As Worksheet, OldSheet As Worksheet
  Dim Faktor As Variant, Counter As Integer
  
  Faktor = InputBox("Jeden X. Punkt übrig lassen ?", "Wieviel löschen ?", "3")
  If IsNumeric(Faktor) = False Then
    MsgBox "Fehler !"
    Exit Sub
  End If
  If Faktor < 1 Then
    MsgBox "Fehler !"
    Exit Sub
  End If
  Faktor = Round(Faktor, 0)
  
  Application.Cursor = xlWait
  
  Set OldSheet = ActiveWorkbook.ActiveSheet
  Set Sheet = ActiveWorkbook.Worksheets.Add(, OldSheet)
  Sheet.Name = OldSheet.Name + " (ausgedünnt)"
  OldSheet.UsedRange.Copy Sheet.Range("A1")
  
  Counter = 0
  For i = 1 To Sheet.UsedRange.Cells.Count
    Counter = Counter + 1
    If Counter = Faktor Then
      Counter = 0
    Else
      Sheet.Range("A" + CStr(i)).Delete
      i = i - 1
    End If
  Next i
  
  Application.Cursor = xlDefault
  MsgBox "Fertig "
End Sub

edit:
Ich sollte noch dazu schreiben, dass das nun n Quicki is. Das Ding funktioniert also nur, wenn sich deine Werte alle in der linken Spalte befinden.
Es legt eine Kopie des Worksheets an und löscht in diesem dann alle entsprechenden Zeilen raus. Vorher gibts du an, die wievielte Zeile jeweils stehenbleiben soll.
 
ansich ist das ding ziemlich cool und wenn mans nicht zu oft benutzt dann sicherlich auch sehr hilfreich. blöde ist nur, daß ich eine tabelle über 3 spalten habe. dann müßte ich jede spalte einzeln bearbeiten und wieder zusammenfügen. aber damit kann ich immerhin arbeiten. vielen dank!