Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
396to400
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
396to400
396to400
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Feld auf Inhalt prüfen

Feld auf Inhalt prüfen
17.03.2004 15:55:01
stephan
Hallo,
hab ne Tabelle mit Messwerten (waagerecht), es soll nun jede Zeile markiert und in neues Dok. kopiert werden. Soweit bin ich ja scho, aber da es immer unterschiedlich viele Zeilen sind, brauch ich ne while schleife, die so lange geht, bis eine komplett leere Zeile kommt...ein weiteres Problem ist, der Dateiname des neuen xls Dokuments. Sollte den Namen des ersten Feldes der A Spalte bekommen, weiss da echt nicht mehr weiter...
Dim intRow As Integer
intRow = 0

Do Until ... ?

intRow = intRow + 1
Rows("intRow:intRow").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.SaveAs ("F:\neueTabelle.xls")
Windows("AusgangsTabelle.xls").Activate

Loop
thx

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Feld auf Inhalt prüfen
17.03.2004 16:28:07
Timo Steuerwald
Hallo stephan,
vielleicht geht das in die richtige Richtung, kommt drauf an ob nach der leeren Zeile noch was kommt, also Bereich der Messwerte = UsedRange:
For Each cell In sheet.UsedRange
' Do something useful
Next cell
~f~
Ansonsten eventuell auch so: Eine Funktion die überprüft ob die leere Zeile erreicht wurde, diese kannst Du als Schleifenbedingung abfragen.
~f~
<pre>
Function emptyRow(row As Integer) As Boolean
Const MAXCOL As Integer = 254
Dim somethingFound As Boolean
While (i < MAXCOL And !somethingFound)
If ActiveSheet.Cells(row, i).Value <> "" Then
somethingFound = True
End If
Wend
emptyRow = !somethingFound
End Function</pre>
~f~
Speichern so:
~f~
ActiveSheet.SaveAs (ActiveSheet.Cells(1, 1).Value)

MfG,
Timo Steuerwald
PS: Keine Ahnung ob das auch wirklich ganz funzt, habs nämlich nicht getestet, aber der Gedanke dürfte Dir vielleicht schon genügen.
Anzeige
AW: Feld auf Inhalt prüfen
17.03.2004 16:53:15
Martin M.
Hallo Stephan
Damit müsstest du weiterkommen. Gute Unterhaltung.
<pre>
Sub Kopieren()
Dim intRow As Integer
Dim ws As Worksheet
Dim wbNeu As Workbook
Dim wsNeu As Worksheet
Dim lastRow As Long

Set ws = ActiveSheet
Set wbNeu = Workbooks.Add
Set wsNeu = wbNeu.ActiveSheet

lastRow = RealLastCell(ws).Row

intRow = 1
Do
wsNeu.Rows(intRow).Value = ws.Rows(intRow).Value
intRow = intRow + 1
Loop Until intRow > lastRow

wbNeu.SaveAs ("F:\neueTabelle.xls")
ws.Activate

End Sub</pre>
' Code von John Walkenbach
<pre>
Function RealLastCell(TheSheet As Worksheet) As Range
Dim ExcelLastCell As Range
Dim Row As Long
Dim Col As Integer
Dim LastRowWithData As Long
Dim LastColWithData As Integer
Set ExcelLastCell = TheSheet.Cells.SpecialCells(xlLastCell)
LastRowWithData = ExcelLastCell.Row
Row = ExcelLastCell.Row
Do While Application.CountA(TheSheet.Rows(Row)) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row
LastColWithData = ExcelLastCell.Column
Col = ExcelLastCell.Column
Do While Application.CountA(TheSheet.Columns(Col)) = 0 And Col <> 1
Col = Col - 1
Loop
LastColWithData = Col
Set RealLastCell = TheSheet.Cells(Row, Col)
End Function</pre>
Anzeige
AW: Feld auf Inhalt prüfen
18.03.2004 11:21:52
stephan
Hi nochmal,
bring das trotz den Tips nich zum Laufen, bin blutiger Anfänger sry :(
Wenn ich das so ausführen will, kommt Fehlermeldung "Nicht genügend Speicher".
Wenn ich nun aber intRow weglasse und Rows("1:1").Select mache, dann läuft das, allerdings bringt das ja nix...aber so macht das für mich Sinn *g* Auch die Bedingung kommt mir egtl. akzeptabel vor, is aber wie ich gemerkt habe wohl doch zu simpel :(
Könnt ihr mir folgendes umschreiben dasses klappt? *hust* Wär genial..thx

Dim intRow As Integer
intRow = 0

Do Until Cells.Value = ""

intReihe = intReihe + 1
Rows("intRow:intRow").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.SaveAs (ActiveSheet.Cells(1, 1).Value)
Windows("AusgansTabelle.xls").Activate

Loop
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige