Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
876to880
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
876to880
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Auswerten

Auswerten
13.06.2007 14:24:47
Christian
Hallo Leute,
ich möchte eine Tabelle etwas aufwerten. Blatt 1 enthält eine Aufstellung sämtlicher Umsätze.
VBA soll sich in dieser Gesamtaufstellung die Spalte B vornehmen und wenn Kriterium ("853") gefunden wurde, die gesamte Zeile in dem Tabellenblatt ("853") Spalte A Zeile 7:27 wiederholen.
Könntet Ihr mir vielleicht helfen ?
Das hab ich bisher:

Private Sub CommandButton2_Click()
With Worksheets("853")
Set gefunden = Worksheets("Stornos Gesamt").Range("B9:B250").Find("853")
gefunden.EntireRow.Copy
Sheets("853").Select
Range("A7:A27").Find ("")
Set gefunden = Worksheets("853").Cells(.Rows.Count, "A7:A27").End(xlUp).Offset(1, 0). _
EntireRow.Insert
End With
End Sub


9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auswerten
13.06.2007 14:49:19
Hajo_Zi
Hallo Christian,
Option Explicit

Private Sub CommandButton2_Click()
'   erstellt von Hajo.Ziplies@web.de  13.06.07
Dim Found As Range
Dim FirstAddress As String
Dim LoLetzte As Long
Dim LoI As Long
Dim ByMldg As Byte
With Worksheets("853")
'       unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count) + 1
If LoLetzte 



AW: Auswerten
13.06.2007 16:26:12
Christian
Hallo Hajo,
sieht gut aus. Aber funktioniert nur für das Tabellenblatt 853 . Ich hab versucht die gleiche Formel für ein weiteres Tabellenblatt zu benutzen - funktioniert aber nicht !
Private Sub CommandButton2_Click()
' erstellt von Hajo.Ziplies@web.de 13.06.07
Dim Found As Range
Dim FirstAddress As String
Dim LoLetzte As Long
Dim LoI As Long
Dim ByMldg As Byte
With Worksheets("853")
' unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count) + 1
If LoLetzte < 7 Then LoLetzte = 7
Set Found = Worksheets("Stornos Gesamt").Range("B9:B250").Find(853, .Range("B250"), , xlWhole, , xlNext)
If Found Is Nothing Then Exit Sub 'falls nicht gefunden wird sub verlassen
Worksheets("Stornos Gesamt").Rows(Found.Row).Copy .Rows(LoLetzte)
LoLetzte = LoLetzte + 1
FirstAddress = Found.Address
Do
Set Found = Worksheets("Stornos Gesamt").Range("B9:B250").FindNext(Found)
If Found.Address = FirstAddress Then Exit Sub
Worksheets("Stornos Gesamt").Rows(Found.Row).Copy .Rows(LoLetzte)
LoLetzte = LoLetzte + 1
If Found.Row = LoLetzte Then Exit Sub
LoI = LoI + 1
Loop While Not Found Is Nothing
End With
With Worksheets("856")
' unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count) + 1
If LoLetzte < 7 Then LoLetzte = 7
Set Found = Worksheets("Stornos Gesamt").Range("B9:B250").Find(856, .Range("B250"), , xlWhole, , xlNext)
If Found Is Nothing Then Exit Sub 'falls nicht gefunden wird sub verlassen
Worksheets("Stornos Gesamt").Rows(Found.Row).Copy .Rows(LoLetzte)
LoLetzte = LoLetzte + 1
FirstAddress = Found.Address
Do
Set Found = Worksheets("Stornos Gesamt").Range("B9:B250").FindNext(Found)
If Found.Address = FirstAddress Then Exit Sub
Worksheets("Stornos Gesamt").Rows(Found.Row).Copy .Rows(LoLetzte)
LoLetzte = LoLetzte + 1
If Found.Row = LoLetzte Then Exit Sub
LoI = LoI + 1
Loop While Not Found Is Nothing
End With

Anzeige
AW: Auswerten
13.06.2007 16:39:00
Hajo_Zi
Hallo Christian,
solche Sachen immer schon vorher dazu schreiben, dann hätte man das schon eingeplant.
Das Problem mit den mehreren Tabellen hätte ich wohl über ein For Next Schleife gelöst. Ich habe nun schon die Zeit investiert die Tabelle für den ersten Code zu erstellen. Bei so komplizierten Sachen sollte man schon eine Beispieldatei hochladen.
Ich mache jetzt erstmal Feierabend bis ca. 19:00 Uhr.

AW: Auswerten
13.06.2007 17:22:37
Christian
Danke soweit Hajo,
ein Hochladen ist leider nicht möglich Firmen-Fire Wall !
Danke trotzdem daß Du Dich so bemühst. - Ich mach jetzt auch erst mal Feierabend.
Morgen mehr.
Tausend Dank !

Anzeige
AW: Auswerten
13.06.2007 19:54:00
Hajo_Zi
Hallo Christian,
ich baue die Datei nicht nach. Darum ohne Testung
Option Explicit

Private Sub CommandButton2_Click()
'   erstellt von Hajo.Ziplies@web.de  13.06.07
Dim Found As Range
Dim FirstAddress As String
Dim LoLetzte As Long
Dim Loi As Long
Dim ByMldg As Byte
Dim LoJ As Long
Dim StTabelle
StTabelle = Array("853", "856", "3")
For LoJ = 0 To UBound(StTabelle)
With Worksheets(StTabelle(LoJ))
'       unabhängig von Excelversion für Spalte A (1)
LoLetzte = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row,  _
Rows.Count) + 1
If LoLetzte 


Gruß Hajo

Anzeige
AW: Auswerten
14.06.2007 08:22:12
Christian
Moin Hajo,
beim debuggen erhalte ich die Meldung "Index außerhalb des gültigen Bereiches" in der folgenden Zeile:
Set Found = Worksheets("Stornos Gesamt").Range("B9:B250").Find(853, .Range("B250"), xlWhole, , xlNext)
Ich habe an der Tabelle selbst nichts geändert - ich schwöre !
Gruß Christian

AW: Auswerten
14.06.2007 08:30:50
Hajo_Zi
Hallo Christian,
ich hatte es schon geschrieben. Zum Nachbau so umfangreicher Tabellen habe ich leider keine Zeit, in der Woche schon gar nicht. Ich habe den Code jetzt nur theoretisch erarbeitet.
Die Tabelle "Stornos Gesamt" gibt es noch, Sie war ja vorher auch vorhanden?
Gruß Hajo

Anzeige
AW: Auswerten
14.06.2007 15:16:00
Hajo_Zi
Hallo Christian,
ich hatte es schon geschrieben. Zum Nachbau so umfangreicher Tabellen habe ich leider keine Zeit, in der Woche schon gar nicht. Ich habe den Code jetzt nur theoretisch erarbeitet.
Die Tabelle "Stornos Gesamt" gibt es noch, Sie war ja vorher auch vorhanden?
Gruß Hajo

AW: Auswerten
Christian
Hallo Hajo,
werde die nächste Woche nicht antworten können. Nochmals - habe an der Tabelle nichts, aber auch gar nichts verändert.
Gruß Christian

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige