Thema Datum  Von Nutzer Rating
Antwort
Rot Stichprobe ziehen
 24.06.2009 14:53:58 Jan Berkemeier
NotSolved
24.06.2009 20:29:36 Holger
NotSolved

Ansicht des Beitrags:
Von:
Jan Berkemeier		 Datum:
24.06.2009 14:53:58		 Views:
2532		 Rating:
     
Antwort:
  Ja
Thema:
Stichprobe ziehen
Hallo zusammen,

ich möchte aus einer Liste von Räumen eine zufällife Stichprobe ziehen. Dabei sollen die Räume mit dem Merkmal "Keine Reinigung bzw. nach Bedarf" nicht berücksichtigt werden.
Anschließend soll Excel wahllos Räume aussuchen. Die Anzahl der Räume soll vorgegeben werden können. Am liebsten mit einem Eingabefeld. Danach soll die gezogene Stichprobe in eine seperate *.xls Datei gespeichert werden (mit Pfadeingabe).
Ich bin schon recht weit gekommen, aber leider musste ich mir einige Krücken bauen. Bin noch nicht so fit in VBA :).
Mein Problem:
1. Wenn ich eine andere Datei öffne, muss ich ggf. den Tabellenblattnamen im Code ändern.
2. Ich muss derzeit noch im Code angeben, wie viele Räume sich in der Liste befinden. Wenn ich pauschal eine Zahl eingebe, kann es sein, dass leere Zellen bei der Stichprobe gezogen werden.
3. Ich muss im Code angeben, wie viele Räume per Stichprobe gezogen werden sollen. Das kann aber bei jeder Datei unterschiedlich sein. Leider bekomme ich den Aufruf eines Eingabefeldes nicht programmiert.
4. Die zufällige Auswahl von Zeilen funktioniert solange ich das Makro seperat aufrufe. Wenn ich jedoch dieses in eine Reihe mehrerer nacheinander ablaufender Makros einfüge, werden immer wieder die gleichen Zeilen ausgewählt. Ich habe die Reihe mittels "Makro aufzeichnen" erstellt und das resultierende Makro einem Kommandobutton zugewiese. Liegt dort mein Fehler?
Der gesamte Ablauf soll folgendermaßen aussehen:

1. die Datei wird geöffnet
2. der Button "Stichprobe ziehen" wird geklickt.
3. Es läuft zunächst das Makro, das die Räume mit dem Merkmal "Keine Reinigung bzw. nach Bedarf" ausblendet.
4. Die übrigen Zellen werden in ein seperates Blatt kopiert. (Auch eine Krücke von mir, da die Zufallsauswahl auch ausgeblendete Zellen berücksichtigt und somit das ungewünschte Merkmal auftauchen kann)
5. Die zufällige Stichprobe wird gezogen
6. Die Spaltenbreite wird optimiert
7. "Speichern Unter" wird aufgerufen mit einem vorgegebenen Text im Eingabefeld.

Private Sub CommandButton1_Click()
Call Stichprobe
End Sub

Sub Stichprobe()

Application.Run "Filter"
Cells.Select
Range("H250").Activate
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("H250").Select
Application.Run "Zufallszeilen"
Application.Run "Spaltenbreite"
Application.Run "Speichern"
End Sub

Sub Filter()
Dim wks As Worksheet
Dim i As Integer
Set wks = ThisWorkbook.Worksheets("zufallsgenerator") '<-- Name des Tabellenblattes anpassen
With wks
For i = 1 To 81 '<-- Die zweite Zahl muss gleich der Anzahl der Räume insgesamt sein'
If .Cells(i, 5).Value = "Keine Reinigung bzw. nach Bedarf" Then
.Rows(i).Hidden = True
Else
.Rows(i).Hidden = False
End If
Next i
End With
End Sub

Sub Zufallszeilen()

Const intMaxZeile = 14 '<-- Anzahl der zu prüfenden Räume'

Dim lngAnzahlZeilen As Long
Dim lngZeile(1 To intMaxZeile) As Long
Dim intZeile As Integer
Dim intTemp As Integer
Dim blnDoppelt As Boolean
Dim rngZeilen As Range

lngAnzahlZeilen = 81 '<-- Hier die Anzahl der Räume insgesamt angeben'

For intZeile = 1 To intMaxZeile
Do
blnDoppelt = False
lngZeile(intZeile) = Int(Rnd() * lngAnzahlZeilen + 1)

For intTemp = 1 To intZeile - 1
If lngZeile(intTemp) = lngZeile(intZeile) Then
blnDoppelt = True
intTemp = intZeile
End If
Next
Loop Until Not blnDoppelt

If intZeile = 1 Then
Set rngZeilen = Rows(lngZeile(intZeile))
Else
Set rngZeilen = Union(rngZeilen, Rows(lngZeile(intZeile)))
End If
Next

rngZeilen.EntireRow.Copy Sheets.Add.[A1]

Set rngZeile = Nothing
End Sub


Sub Spaltenbreite()

Dim Spalte As Long, i As Long

Spalte = ActiveSheet.Cells.SpecialCells(xlLastCell).Column

For i = 1 To Spalte

ActiveSheet.Columns(i).EntireColumn.AutoFit

Next i

End Sub

Sub Speichern()
Dim varDateiname As Variant

ChDir "\"
ChDrive "c:\"

varDateiname = Application.GetSaveAsFilename _
("stichprobe.xls", "Microsoft Excel-Dateien (*.xls),*.xls")

If TypeName(varDateiname) = "String" Then
ActiveSheet.Copy
ActiveWorkbook.SaveAs varDateiname
ActiveWorkbook.Close
MsgBox "Dateiname :" & vbLf & vbLf & varDateiname, vbOKOnly + vbInformation, "Datei wurde gespeichert :"
End If

End Sub

Ich hoffe, ich habe alles ausreichend beschrieben. Viele Dank im Voraus.

Gruß Jan

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Stichprobe ziehen
 24.06.2009 14:53:58 Jan Berkemeier
NotSolved
24.06.2009 20:29:36 Holger
NotSolved