Re: Bereich zählen für Autofill
10.04.2003 19:49:30
Peter Knierim
Hallo Lothardein Makro funktioniert, aber
wie binde ich das in mein makro ein
also: alles ohne Überschrift
dann wird in Spalte A Daten eingelesen
dann wird in Spalte B eine Datenreihe erstellt
dann wird in Spalte D eine neue Liste mit unbestimmten zeilenzahl berechnet das wäre dann mein Wert "AnzRows"
Durch den Befehl Gehezu Inhalte Aktueller Bereich wird die Anzahl der Zeilen ermittelt.
In Spalte E,F,G wird eine Formel eingefügt, die so oft nach unter kopiert wir wie in Spalte D Zeilen gezählt worden sind.
Dann wird der Bereich Schaltliste kopiert und nur die Werte in eine neue Datei eingefügt.
das Problem ist wenn in spalte d nur D1 ein Wert berechnet worden ist läuft mein Makro auf Fehler, weil der Füllbereich nicht gesetzt werden kann.
es sollte so sein, das dann in der neuen Datei eben nur eine zeile kopiert ist.
hier mein Makro
Private Sub CommandButton6_Click()
Sheets("Frei Ports").Select
Dim r1 As Long
Dim r2 As Long
Dim r3 As Long
Dim vorhanden As Boolean
r3 = 1
For r2 = 1 To Range("B65536").End(xlUp).Row
vorhanden = False
For r1 = 1 To Range("A65536").End(xlUp).Row
If Cells(r2, 2) = Cells(r1, 1) Then vorhanden = True
Next r1
If Not vorhanden Then
Cells(r3, 4) = Cells(r2, 2)
r3 = r3 + 1
End If
Next r2
Application.Cells(1, 5).FormulaLocal = "=wenn(istfehler(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;2;FALSCH));"""";wenn(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;2;FALSCH)=0;""MX"";SVERWEIS(Freie_Ports;FreiePort_Suchbereich;2;FALSCH)))"
Application.Cells(1, 6).FormulaLocal = "=wenn(istfehler(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;3;FALSCH));"""";wenn(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;3;FALSCH)=0;""MX"";SVERWEIS(Freie_Ports;FreiePort_Suchbereich;3;FALSCH)))"
Application.Cells(1, 7).FormulaLocal = "=wenn(istfehler(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;4;FALSCH));"""";wenn(SVERWEIS(Freie_Ports;FreiePort_Suchbereich;4;FALSCH)=0;""MX"";SVERWEIS(Freie_Ports;FreiePort_Suchbereich;4;FALSCH)))"
Range("D1").Select
Selection.CurrentRegion.Select
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 5), Cells(1, 7))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 5), Cells(Selection.Rows.Count, 7))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
Range("D1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Else
For i = 1 To Zähler
Next i
End If
Range("Schaltliste").Select
Selection.Copy
Sheets("Freie Port Liste").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Frei Ports").Select
Application.CutCopyMode = False
Sheets("Freie Port Liste").Select
ActiveCell.Select
Sheets("Freie Port Liste").Select
frmFreie_Ports_ermitteln.Hide
frmSuchen.Hide
Sheets("Freie Port Liste").Copy
'Neue Datei zum Bearbeiten fertig
Mldg = "Liste wurde erfolgreich erstellt. " & Chr(13) & _
"Freie Ports wurden ermttelt " & Chr(13) & _
"und mit Zurü-Daten aus KontesOrka" & Chr(13) & _
"Liste OA35 verknüpft." & Chr(13) & _
"" & Chr(13) & _
"Peter Knierim BBN 28 Fulda"
Stil = vbOKOnly + vbInformation + vbDefaultButton1
Title = "Datensatzsuchprogramm"
Kontext = 1000
Ergebnis = MsgBox(Mldg, Stil, Title, Help, Kontext)
'schließt das Programm ohne die Daten zuspeichern
Windows("Datensatzsuchprogramm.XLS").Activate
ActiveWorkbook.Close SaveChanges:=False
End Sub
schau doch mal ob du mir helfen kannst
Gruß Peter