Anzeige
Archiv - Navigation
1076to1080
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

Vba count.row bei leer zeilen

Vba count.row bei leer zeilen
23.05.2009 15:46:16
Carmen
Hallo zusammen,
hänge mal wieder bei vba. und zwar hab ich eine export tabelle (Tabelle1)die zwischen den relevanten Zeile leere zeilen und spalten hat. nun möchte ich diese tabelle in ein neues blatt kopieren, weiß aber nicht wie ich die größe ermitteln kann trotz der leerzeilen und spalten.aus den zeilen die nur teilweise gefüllt sind sollen teilweise informationen vor die spalten mit datum kopiert werden. Das funktioniert auch.
Die Tabelle soll dann eigentlich so aussehen die in Datenbasis, da dort eine Pivot draufgelegt werden soll.
Folgendes hab ich bereits, wenn auch nicht sonderlich professionell.
Weiß jemand wie ich die größe der tabelle ermitteln kann trotz der eeren spalten und zeilen?
https://www.herber.de/bbs/user/61995.xlsx

Sub Startroutine()
Application.ScreenUpdating = False
'Hier soll noch was hin damit die Daten in Tab Daten_Basis E2 kopiert werden.
'die Größe der Tabelle zu ermitteln,Hürde sind die leer Zeillen und Spalten.
'Dann kann Spalten_einfügen weg.
Kst_kopieren
Kostenart
Name_Kst
Name_Kostenart
'fehlt Kopieren bis Ende Tabelle, wieder Hürde die leer Zeilen.
einfuegen_werte
ZellenAusfuellen
LeereZeilenLöschen
Application.ScreenUpdating = True
End Sub



Sub Kst_kopieren()
' Kst_kopieren Makro
Range("A5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[4]=""Kostenstelle"",R[-3]C[6],"""")"
End Sub



Sub Kostenart()
Range("C5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[2]=""Kostenart"",R[-1]C[4],"""")"
End Sub



Sub Name_Kst()
Range("B5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[3]=""Kostenstelle"",R[-3]C[9],"""")"
End Sub



Sub Name_Kostenart()
Range("D5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=""Kostenart"",R[-1]C[8],"""")"
End Sub



Sub einfuegen_werte()
Columns("A:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub



Sub ZellenAusfuellen()
Dim Zelle As Range
Application.ScreenUpdating = False
For Each Zelle In Range("A5:D" & Cells(Rows.Count, "D").End(xlUp).Row)
If Zelle = "" Then Zelle = Zelle.Offset(-1, 0)
Next
Application.ScreenUpdating = True
End Sub



Sub LeereZeilenLöschen()
Dim i As Long
Dim n As Long
Dim zeileletzte As Long
zeileletzte = Active.Sheet.UsedRange.Rows.Count
For i = zeileletzte To 1 Step -1
If Cells(i, 6) = "" And Cells(i, 8) = "" Then
Rows(i).EntireRow.Delete
n = n + 1
End If
Next i
MsgBox "Es sind" & Format(n, "#,##0") & _
"Zeilen gelöscht worden!", _
vbInformation, ""
End Sub


Grüße Carmen

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vba count.row bei leer zeilen
23.05.2009 16:17:50
Josef
Hallo Carmen,
eine Möglichkeit.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function lastCell(TheSheet As Worksheet) As Range
  Dim lngCol As Long, lngIndex As Long, lngRow As Long
  
  With TheSheet
    lngCol = Application.Max(1, .Cells(1, Columns.Count).End(xlToLeft).Column)
    lngRow = 1
    For lngIndex = 1 To lngCol
      lngRow = Application.Max(lngRow, .Cells(Rows.Count, lngIndex).End(xlUp).Row)
    Next
    Set lastCell = .Cells(lngRow, lngCol)
  End With
  
End Function


Sub test()
  With lastCell(ActiveSheet)
    Debug.Print .Address, .Row, .Column
  End With
End Sub

Gruß Sepp

Anzeige
AW: Vba count.row bei leer zeilen
23.05.2009 16:24:04
Carmen
super, vielen Dank!
AW: Vba count.row bei leer zeilen
24.05.2009 10:25:14
Carmen
Hallo Josef,
hab noch eine klitzekleine Frage die Du sicher beantworten kanst.
Ich möchte aus der Funktion, die super läuft, nochmals danke!, nur lngRow in einer anderen Prozedur
verwenden. Ich dachte mir das geht vielleicht so: For each Zelle in Range("A5:D" &lngRow) aber das will er nicht.
Hast Du oder wer es sonst auch weiß einen Tipp? In meinen vba für anfänger büchern finde ich nur die man den namen der gesamten funktion einbindet.
Vielen Dank
Grüße Carmen
AW: Vba count.row bei leer zeilen
24.05.2009 10:27:20
Carmen
sorry, vergessen auf status offen zu setzen
AW: Vba count.row bei leer zeilen
24.05.2009 10:33:33
Josef
Hallo Carmen,
das geht so.
Sub carmen()
  Dim lngRow As Long, Zelle As Range
  
  lngRow = lastCell(ActiveSheet).Row
  
  For Each Zelle In Range("A5:D" & lngRow)
    '...
  Next
End Sub

Gruß Sepp

Anzeige
AW: Vba count.row bei leer zeilen
24.05.2009 10:35:19
Carmen
Toll, vielen Dank!!!
AW: Vba count.row bei leer zeilen
24.05.2009 12:12:53
Carmen
wie sollte es anders sein, hab noch eine Frage.
lngRow = lastCell(ActiveSheet).Row
die funktion wurde in tabellenblatt einzelnachweis ausgeführt, dann markiert und in basisdaten E2 eingefügt. die formeln in a2:d2 erstellt. und jetzt möchte ich in den formel das die lngRow genommen wird die in einzelnachweis ermittelt wurde, des halb sah meine formel so aus
lngRow = lastCell("einzelnachweis").Row
tut mir leid ist sicher auch wieder total einfach....nur leider noch nicht für mich, da ich das grundprinzip noch nicht durchdrungen habe.
Vielen Dank!
Grüße Carmen
Anzeige
AW: Vba count.row bei leer zeilen
24.05.2009 12:19:56
Josef
Hallo Carmen,
wie sieht den die Formel aus die erstellt werden soll?
Gruß Sepp

Fehler bemerkt
24.05.2009 12:54:45
Josef
Hallo Carmen,
die Funktion erwartet ein Worksheet-Objekt und nicht den Namen des Worksheets.

lngRow = lastCell(Sheets("einzelnachweis")).Row


Gruß Sepp

AW: Fehler bemerkt
24.05.2009 15:50:06
Carmen
Hallo Sepp,
die ganzen Subs funktionieren als einzelnes gut, dank Dir! und was nicht geht hab ich verzapft. nur bekomme ich es nicht im zusammenspiel hin.
Option Explicit (hab ich noch etwas rangehängt)

Private Function lastCell(TheSheet As Worksheet) As Range
Dim lngCol As Long, lngIndex As Long, lngRow As Long
With TheSheet
lngCol = Application.Max(1, .Cells(1, Columns.Count).End(xlToLeft).Column)
lngRow = 1
For lngIndex = 1 To lngCol
lngRow = Application.Max(lngRow, .Cells(Rows.Count, lngIndex).End(xlUp).Row)
Next
Set lastCell = .Cells(lngRow, lngCol)
End With
Range(Cells(2,1), Cells(lngRow, lngColl)).select
Selection.copy
Sheets("Datenbasis").Select
Range("E2").select
ActiveSheet.Paste
End Function


Das fügt die Daten wie ermittelt dann auch in Tab Datenbasis an der richtigen stelle ein.
nun kommen formeln in A5:D5 auch per vba und läuft
die möchte ich runterkopieren mit Hilfe von
Sub formelkopieren
Dim lngRow As Long
lngRow=lastcell(sheets("einzelnachweis")).Row
Range ("A5:D5").select
selection.Copy
Range("A6:D" & lngRow).Select
Active.sheet.Paste
End Sub


Danach möchte ich A5:D markieren und werte einfügen aber soweit bin ich noch nicht. Denn nach formelnkopieren hab ich vor der Tab in datenbasis 4 neue spalten eingefügt und kopiere leere zellen nach unten und nicht die eigentlich ausgewählten formeln. Das liegt daran dass ich in der funktion den zusatz gemacht hab. Leider weiß ich nicht wie sonst, war so froh dass es funktioniert, aber zu früh gefreut.
Hast da noch einen Tipp?
Sonnige Grüße
Carmen

Anzeige
AW: Fehler bemerkt
24.05.2009 16:37:47
Josef
Hallo Carmen,
die Funktion gibt eine Rückgabe, in unserem Fall eine Zelle, da gehört kein weiterer Code rein!
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function lastCell(TheSheet As Worksheet) As Range
  Dim lngCol As Long, lngIndex As Long, lngRow As Long
  
  With TheSheet
    lngCol = Application.Max(1, .Cells(1, Columns.Count).End(xlToLeft).Column)
    lngRow = 1
    For lngIndex = 1 To lngCol
      lngRow = Application.Max(lngRow, .Cells(Rows.Count, lngIndex).End(xlUp).Row)
    Next
    Set lastCell = .Cells(lngRow, lngCol)
  End With
  
End Function


Sub formelkopieren()
  Dim lngRow As Long
  
  lngRow = lastCell(Sheets("einzelnachweis")).Row
  
  Sheets("einzelnachweis").Range(Cells(2, 1), Cells(lngRow, lngColl)).Copy Sheets("Datenbasis").Range("E2")
  
  Sheets("Datenbasis").Range("A5:D5").AutoFill Sheets("Datenbasis").Range("A5:D" & lngRow)
  
  
End Sub

Da ich deine Daten nicht kenne und auch nicht weis was du genau erreichen willst, ist es schwer
mehr Hilfestellung zu geben.
Gruß Sepp

Anzeige
Korrektur!
24.05.2009 16:41:37
Josef
Sub formelkopieren()
  Dim lngRow As Long, lngCol As Long
  
  With lastCell(Sheets("einzelnachweis"))
    lngRow = .Row
    lngCol = .Column
  End With
  
  Sheets("einzelnachweis").Range(Cells(2, 1), Cells(lngRow, lngCol)).Copy Sheets("Datenbasis").Range("E2")
  
  Sheets("Datenbasis").Range("A5:D5").AutoFill Sheets("Datenbasis").Range("A5:D" & lngRow)
  
  
End Sub

Gruß Sepp

Anzeige
mein ziel
24.05.2009 21:45:20
Carmen
Hallo Sepp,
hier der versuch mein ziel genau zu beschreiben.

Die Datei https://www.herber.de/bbs/user/62025.xls wurde aus Datenschutzgründen gelöscht


In der Datei im Blatt Einzelnachweis sind daten wie sie aus einem export kommen. Diese Daten möchte ich so dargestellen wie im blatt Datenbasis als grundlage einer Pivottabelle.
Nun habe ich von Dir die

Function zur ermittelung der größe
danach wird die tabelle einzelnachweis in datenbasis E2 kopiert mit


Sub tabkopieren()
Dim lngRow As Long, lngCol As Long
With lastCell(Sheets("Einzelnachweis"))
lngRow = .Row
lngCol = .Column
End With
Sheets("Einzelnachweis").Range(Cells(2, 1), Cells(lngRow, lngCol)).Copy Sheets("Datenbasis"). _
Range("E2")
End Sub


funktioniert!
nun sollen die zellen in den kostenstellen und kostenart hinterlegt sind mit wennfunktion in die zellen A5:D5


Sub Kst_kopieren()
' Kst_kopieren Makro
Range("A5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[4]=""Kostenstelle"",R[-3]C[6],"""")"
End Sub



Sub Kostenart()
Range("C5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[2]=""Kostenart"",R[-1]C[4],"""")"
End Sub



Sub Name_Kst()
Range("B5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[3]=""Kostenstelle"",R[-3]C[9],"""")"
End Sub



Sub Name_Kostenart()
Range("D5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=""Kostenart"",R[-1]C[8],"""")"
End Sub


funktioniert auch!
Wie Formeln sollen nun nach unten bis zur letzten zeile kopiert werden. Größe der Tabelle dachte ich mir nehme ich aus der Funktion.


Sub formelkopieren()
Dim lngRow As Long, lngCol As Long
With lastCell(Sheets("Einzelnachweis"))
lngRow = .Row
lngCol = .Column
End With
Sheets("Datenbasis").Range("A5:D5").AutoFill Sheets("Datenbasis").Range("A6:D" & lngRow)
End Sub


Das geht leider nicht, und ich weiß nicht warum Fehler 1004
Danach sollen die Formeln kopiert werden und durch werte ersetzt.


Sub einfuegen_werte()
Columns("A:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub


das geht
nun sind nicht alle zellen mit den Daten gefüllt deshalb die prüfung ob zelle unterhalb leer ist dann die obere runterkopieren


Sub ZellenAusfuellen()
Dim Zelle As Range
Dim lngRow As Long
lngRow = lastCell(ActiveSheet).Row
Application.ScreenUpdating = False
For Each Zelle In Range("A5:D" & lngRow)
If Zelle = "" Then Zelle = Zelle.Offset(-1, 0)
Next
Application.ScreenUpdating = True
End Sub


funktioniert
nun sollen die leeren zeilen gelöscht werden dazu dies


Sub LeereZeilenLöschen()
Dim i As Long
Dim n As Long
Dim lngRow As Long
lngRow = lastCell(ActiveSheet).Row
For i = lngRow To 1 Step -1
If Cells(i, 6) = "" And Cells(i, 8) = "" Then
Rows(i).EntireRow.Delete
n = n + 1
End If
Next i
MsgBox "Es sind" & Format(n, "#,##0") & _
"Zeilen gelöscht worden!", _
vbInformation, ""
End Sub


das geht
jetzt fehlen noch die leeren spalten


Sub leereSpaltenlöschen()
Dim z As Long
For z = 12 To 1 Step -1
If Application.CountA(Range(Cells(1, z), Cells(12, z))) = 0 Then
Columns(z).Delete
End If
Next
End Sub


Das geht nicht richtig da es spalten überspringt.
Das ganz möchte ich über eine Startroutine anschieben.
das vorgehen ist schritt für schritt, da ich es so schon hinbekomme.
also lieber Sepp, wenn Du noch einen oder meherere tipps hast, bin ich froh.
Aber auch so vielen Dank für Deine bereits geleistete Unterstützung!!!
Grüße Carmen

Anzeige
AW: mein ziel
24.05.2009 23:34:01
Carmen
Sepp Du bist der Beste, das läuft!!!
Nur eine kleinigkeit ist, dass die spalten in denen die wörter Kostenstelle und kostenart etc. stehen, in orginal Einzelnachweis spalten A C E G und H nach LeereZeilen_Und_Spalten_Löschen noch vorhanden sind.
ich versuch das morgen mal in dem ich sage die zeilen die in datenbasis F kein datum enthalten können gelöscht werden.
wenn Du einen besseren tipp hast nehm ich den gerne!
Bei dem versuch Dein gesamtwerk zu verstehen werd ich noch ne weile brauchen!
Nochmals vielen Dank!!!
Grüße Carmen
Anzeige

171 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige