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

Zellen finden u. dazugehörige Zeile kopieren

Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 14:21:36
Peter
Hallo erstmal
trotz intensivster Recherche auf der CD und in den online Archiven, ist es mir leider nicht gelungen, ein für mich funktionierendes Makro zu erstellen. Ich weiß das es sehr nervig sein kann, wenn im Grunde genommen immer dasselbe gefragt wird, obwohl sich hunderte von ähnlichen b.z.w fast gleichen Fragen und Beispieldateien in den Archiven befinden. Tatsache ist aber, das Excel in seinem ganzen Umfang so groß ist, das die individuellen Lösungsansätze einfach nicht weiterhelfen . . . vor allem denen nicht, die bei dim bim integer boolean wks data und was weiß ich noch alles mit einem Gehirnvacuum zu kämpfen haben ( so wie ich).
Mein Problem
Meine aktive Mappe (Extrakt.xls) soll eine Mappe öffnen (VSDBA00001.xls) - Funktioniert
Die Werte sind nach Spalte A sortiert (A1:EU17000)
1. sollen jetzt die Zellen in Spalte A gefunden werden, die größer als 54 sind.
Die dazugehörigen Zeilen(z.B A1:EU1) sollten dann in meine Mappe Extrakt.xls/Tabellenblatt Ü54 kopiert werden(nur Werte und untereinander !!!)
Sollten keine Daten vorhanden sein, soll es auch keine Fehlermeldung geben.
2.wird das ganze nochmals wiederholt, diesmal mit der Bedingung, das die Werte kleiner als 6 sind.
Die dazugehörigen Zeilen(z.B A5:EU5) sollten dann in meine Mappe Extrakt.xls/Tabellenblatt U6 kopiert werden(nur Werte und untereinander !!!)
Sollten keine Daten vorhanden sein, soll es auch keine Fehlermeldung geben.
3.wären es insgesamt 350 Mappen mit fortlaufender Nummer . . . eine elegante Lösung wäre natürlich schön, muß aber nicht sein
Wichtig sind die Punkte 1 und 2
Mein sehr bescheidener Versuch :
Workbooks.Open Filename:="C:\Excellent\04 Auswertung\VSDBA00001.xls"
If Range(Cells(row, 1), Cells(row, 1)).Value = "größer"54" Then
ActiveCells.EntireRows.Copy
startet mit einer Fehlermeldung den Debugger in der zweiten Zeile . . .?
Mit freundlichen Grüßen
Peter
PS- Das Größer Zeichen ist mir bekannt, gab bei der Vorschau einen Fehler

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 14:56:18
Josef
Hallo Peter!
Versuch mal diesen Code!

Sub Extract_Data()
Dim wkbVS As Workbook
Dim wks54 As Worksheet
Dim wks6 As Worksheet
Dim lRow_VS As Long
Dim lRow54 As Long
Dim lRow6 As Long
Dim lRow As Long
Dim strVS_name As String
Dim strExt As String
Dim iCnt As Integer
strVS_name = "VSDBA" 'Dateiname ohne Nummerierung!
strExt = ".xls"
lRow54 = 1  'Startzeile in "Ü54"
lRow6 = 1   'Startzeile in "U6"
'Bildschirmaktualisierung, Ereignisse und Berechnung ausschalten
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error GoTo ERRORHANDLER
Set wks54 = ThisWorkbook.Sheets("Ü54") 'Tabelle "Ü54"
Set wks6 = ThisWorkbook.Sheets("U6")   'Tabelle "U6"
For iCnt = 1 To 350  'Für die Dateien "VSDBA00001.xls" bis VSDBA00350.xls
Set wkbVS = Workbooks.Open(strVS_name & Format(iCnt, "00000") & strExt)
lRow_VS = wkbVS.Sheets(1).Range("A65536").End(xlUp).Row  'Zeilenanzahl feststellen
Application.StatusBar = "Bearbeite Datei  " & strVS_name & Format(iCnt, "00000") & strExt
With wkbVS.Sheets(1)
For lRow = 1 To lRow_VS
If .Cells(lRow, 1) > 54 Then
.Cells(lRow, 1).EntireRow.Copy wks54.Cells(lRow54, 1)
lRow54 = lRow54 + 1
ElseIf .Cells(lRow, 1) < 6 Then
.Cells(lRow, 1).EntireRow.Copy wks6.Cells(lRow6, 1)
lRow6 = lRow6 + 1
End If
Next
End With
wkbVS.Close False
Next
ERRORHANDLER:
'Bildschirmaktualisierung, Ereignisse und Berechnung einschalten
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

!!!Achtung!!!
Der Code ist ungetestet, weil ich mir nicht die Mühe machen wollte,
Mehrere Tabellen zu erstellen!
Probier den Code in einer Testmappe aus!
Der Code gehört in ein allgeneines Modul in "Extrakt.xls"
Gruß Sepp
Anzeige
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 16:04:27
Peter
Hallo Josef
erstmal Vielen Dank für die schnelle Antwort und die Mühe.
Habe das Makro in ein Modul kopiert . . .
Problem - Die VSDBA Mappen werde scheinbar nicht geöffnet, es gibt demnach auch keine Ergebnisse. Die in Anführungszeichen gesetzten Beschreibungen in Deutsch, können doch ebenso wie die Leerzeilen stehen bleiben ?
Mit freundlichem Gruß
Peter
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 16:10:13
Josef
Hallo Peter!
Die mappen werden "unsichtbar" geöffnet!
Führe das Makro im VBA-Editor mal im Einzelschrittmodus aus.
Im Projekt-Explorer müssten dann die geöffneten Mappen zu sehen sein.
Stehen die Werte in Spalte "A" als Zahlen, oder sind es Texte?
Falls es sich um Textwerte handelt, dann müsstest du statt " &gt 54 ",
" &gt "54" " bzw. " &gt "6" " schreiben.
Gruß Sepp
Anzeige
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 16:21:59
Peter
ja ja die Langeweile . . .Danke das du dir die Zeit nimmst.
hatte zu Überprüfung das Screen Updating aktiviert, die "Testmappen" enthalten natürlich die gesuchten Werte. Werde das nochmal im Einzelschritt Modus probieren.
Die Werte in Spalte A sind Zahlen, daran kann es nicht liegen.
MfG
Peter
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 16:54:36
Peter(Od.)
Ja es funktioniert
Warum es jetzt klappt weiß ich auch nicht, aber das ist ja auch egal.Ablauf und Geschwindigkeit sind einfach nur gut.
Ein großes Dankeschön an dich Josef
Ich wünsche dir ein unterhaltsames und abwechslungsreiches Wochenende
Mit freundlichen Grüßen
Peter Od.
Anzeige
AW: Zellen finden u. dazugehörige Zeile kopieren
06.11.2004 17:00:42
Josef
Hallo Peter!
Freut mich das es klappt!
Etwas hab' ich vergessen.
In den letzen "With" Rahmen gehört noch
.StatusBar = False
damit die Statusanzeige wieder zurückgestellt wird!
Gruß Sepp
AW: Zellen finden u. dazugehörige Zeile kopieren
07.11.2004 12:25:05
Peter
Hallo Josef
nur um ganz sicher zu gehen . . .
ist das so Ok(ohne Leerzeilen) ?
ERRORHANDLER:
'Bildschirmaktualisierung, Ereignisse und Berechnung einschalten
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Ja, ist OK! o.T.
07.11.2004 13:30:48
Josef
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige