Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1244to1248
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
Inhaltsverzeichnis

Werte in TATSÄCHLICH erste freie Zeile trotz Filte

Werte in TATSÄCHLICH erste freie Zeile trotz Filte
Dietmar
Hallo zusammen,
folgender Code funktioniert ganz gut, hat aber noch Verbesserungspotential.
Die Prozedur ist Teil eines übergeordneten Codes; der Aufruf erfolgt mit Application.Run ...
1.) Wenn Filter gesetzt ist werden keine Daten in die erste freie Zeile eingetragen, weil der ShowAllData-Befehl
nur dann funktioniert, wenn der unten aufgeführt Code bei aktiviertem Sheet "Statistik" ausgeführt
wird. Der Befehl soll aber als Teil eines übergeordneten Codes durch einen Button angestoßen werden, der
sich in einem anderen Sheet befindet.
2) Die Daten aus A30:AO30 sollen in die ERSTE freie Zeile eingetragen werden. Wenn jedoch zwischendurch
leere Zeilen sind, werden diese leider ignoriert.
3) Das Sahnhäubchen wäre es, wenn ich mich um die ShowAllDate-Situation gar nicht kümmern müsste,
sondern der Code unabhängig von der Filtersituation die tatsächlich erste freie Zeile fände.
Hat jemand eine Idee?
Habe weiter unten mal einen Code von Sepp versucht umzuschreiben ... hat nicht geklappt :-(
Viele Grüße
Dietmar aus Aachen
Sub TagesergebnisInStatistik()
Application.EnableEvents = False
If Sheets("Statistik").FilterMode Then Sheets("Statistik").ShowAllData
With Worksheets("Statistik")
.Range("A30:AO30").Value = .Range("A28:AO28").Value
.Range("A30:AO30").Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:= _
xlPasteValuesAndNumberFormats,   Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Range("B33").Select
Application.EnableEvents = True
End Sub

Mein Versuch einen Code von Sepp umzuschreiben, den er hier mal für die Ermittlung der ersten freien SPALTE gepostet hatte. Bin leider gescheitert. Vielleicht hat jemand eine Idee und dies wäre dann die Lösung.
  Dim lngFirstFree As Long, strRange As String
strRange = Range(Cells(1, 30), Cells(Rows.Count, 33)).Address(0, 0)
lngFirstFree = Evaluate("MIN(IF(ISBLANK(" & strRange & _
"),Rows(" & strRange & ")))")
With Range("A30:AO30")
Cells(lngFirstFree, 33).Resize(.Rows.Count, 1) = .Value
End With

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Werte in TATSÄCHLICH erste freie Zeile trotz Filte
17.01.2012 12:51:12
Josef

Hallo Dietmar,
probiere es so.
Sub TagesergebnisInStatistik()
  Dim rngFree As Range
  
  On Error GoTo ErrExit
  
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  
  With Worksheets("Statistik")
    .Range("A30:AO30").Value = .Range("A28:AO28").Value
    Set rngFree = FirstEmptyCell(.Range("A30:A" & .Rows.Count))
    .Range("A30:AO30").Copy
    rngFree.PasteSpecial Paste:= _
      xlPasteValuesAndNumberFormats, Operation:= _
      xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
  End With
  
  Range("B33").Select
  
  ErrExit:
  
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With
  
  Set rngFree = Nothing
End Sub


Public Function FirstEmptyCell(Target As Range) As Range
  Dim vntRet As Variant
  With Target
    vntRet = Evaluate("MIN(IF(" & .Address & "="""",ROW(" & .Address & _
      ")+COLUMN(" & .Address & ")*10^-6))")
    If IsError(vntRet) Or vntRet = 0 Then Exit Function
    Set FirstEmptyCell = .Cells(Clng(Split(vntRet, ",")(0)) - .Rows(1).Row + 1, _
      Clng(Split(vntRet, ",")(1)) - .Columns(1).Column + 1)
  End With
End Function



« Gruß Sepp »

Anzeige
echt stark ! DANKE! ...
17.01.2012 14:23:38
Dietmar
Hallo Sepp,
einfach klasse!
Habe noch folgende Anpassungen vorgenommen:
1) Zwischenkopier-Aktion von A28:AP28 nach A30:AP30 auskommentiert und direkt die Formelergebnisse aus
A28:AP28 kopiert. (siehe unten). Das war noch ein Überbleibsel aus einer Zeit als ich noch meinte Formeln
erst in Werte umwandeln zu müssen, bevor ich Sie in den filterbaren Datenpool übernehmen könnte.
2) Relevanz der Prüfung der ersten freien Zeile ab Zeile 33
Deinem Code hat es nicht geschadet; funktioniert 1A mit Sternchen!
Dankbare Grüße
Dietmar aus Aachen
  With Worksheets("Statistik")
'.Range("A30:AP30").Value = .Range("A28:AP28").Value
Set rngFree = FirstEmptyCell(.Range("A33:A" & .Rows.Count))
.Range("A28:AP28").Copy
rngFree.PasteSpecial Paste:= _
xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With

Anzeige

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige