Microsoft Excel

Herbers Excel/VBA-Archiv

Werte in TATSÄCHLICH erste freie Zeile trotz Filte | Herbers Excel-Forum


Betrifft: Werte in TATSÄCHLICH erste freie Zeile trotz Filte von: Dietmar aus Aachen
Geschrieben am: 17.01.2012 12:08:06

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

  

Betrifft: AW: Werte in TATSÄCHLICH erste freie Zeile trotz Filte von: Josef Ehrensberger
Geschrieben am: 17.01.2012 12:51:12


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 »



  

Betrifft: echt stark ! DANKE! ... von: Dietmar aus Aachen
Geschrieben am: 17.01.2012 14:23:38

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



Beiträge aus den Excel-Beispielen zum Thema "Werte in TATSÄCHLICH erste freie Zeile trotz Filte"