Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1000to1004
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

Schleifen

Schleifen
11.08.2008 20:02:00
Christian
Hallo Profis,
Benötige Eure Hilfe für folgendes Problem:
Habe eine Tabelle, mit ca. 5000 Einträgen.
Möchte nach Posten Suchen, bei denen alle 4 Kriterien übereinstimmen und diese dann ausschneiden und auf einmal in das Tabellenblatt "Archiv" kopieren. (auch wenn die Zellen nicht zusammenhängen)
https://www.herber.de/bbs/user/54525.xls

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleifen
11.08.2008 20:11:00
Chris
Hmm hallo habe gerade mal deine Mappe angeschaut.
Klappt doch? Sucht nach den 3 Kriterien und kopiert die Zeile in der er diese findet ?
Oder sehe ich da etwas falsch ?
gruß Chris

AW: Schleifen
11.08.2008 20:14:00
Chris
Jetzt sehe ich das Problem...
Was hälst du davon die Zellen nicht auszuschneiden sondern zu löschen ?
Und dann kannst du ja in deiner such routine zählen wie viele treffer er gefunden hat und diese Anzahl dann in die Zieltabelle schreiben ?
Bekommst du das hin oder brauchst du hilfe ?
gruß Chris

AW: Schleifen
12.08.2008 14:36:00
Christian
Hallo Chris,
hast Du dafür mal ein Beispiel ? Oder kannst Du mir das verbasteln und hochladen ?
Gruß Christian

Anzeige
AW: Schleifen
11.08.2008 20:27:39
Tino
Hallo,
gehts so?

Sub Test()
Dim A As Long
Dim strWert As String, strSuchWert As String
strSuchWert = "4711481249135014"
Application.ScreenUpdating = False
For A = Range("F:J").SpecialCells(xlCellTypeLastCell).Row To 10 Step -1
Wert = Cells(A, "F") & Cells(A, "G") & Cells(A, "H") & Cells(A, "J")
If strWert = strSuchWert Then
With Sheets("Archiv")
Range(Cells(A, "F"), Cells(A, "J")).Copy .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
Rows(Cells(A, "F").Row).Delete
End With
End If
Next A
Application.ScreenUpdating = True
End Sub


Gruß Tino

Anzeige
AW: Schleifen
12.08.2008 14:30:56
Christian
Hallo Tino,
funktioniert leider nicht - hast Du noch `ne andere Lösung ?
Gruß Christian

AW: Schleifen
12.08.2008 20:50:00
Tino
Hallo,
könntest du bitte etwas genauer werden, und auch sagen was nicht geht?
Gruß Tino

AW: Schleifen
13.08.2008 08:32:44
Christian
Hallo Tino,
ich hab den Programm Code von Dir herauskopiert, in die Tabelle gesetzt, und start geklickt, pfunzt nicht.
Wie hast Du das denn gemacht ?
Christian

AW: Schleifen
13.08.2008 08:47:00
Christian
Du hast z.B. den Begriff "Wert" von " Wert = Cells(A, "F") & Cells(A, "G") & Cells(A, "H") & Cells(A, "J") nicht definiert. Da fragt er natürlich nach einer Definition.
Wenn dann keine Meldefenster mehr erscheinen, und der code abgespult wird, passiert in der Tabelle genau nichts.
Ich kann Dir leider nur das beschreiben, was ich sehe.
Gruß Christian

Anzeige
AW: Schleifen
13.08.2008 15:44:00
Tino
Hallo,
nicht immer darauf warten, dass man etwas Fertiges vor die Füße geworfen bekommt.
Mit etwas mitdenken kann man sich doch wohl vorstellen dass dies
strWert = Cells(A, "F") & Cells(A, "G") & Cells(A, "H") & Cells(A, "J")
heißen muss.
Da ja auch die Deklarierung dazu so ist.
Gruß Tino

AW: Schleifen
13.08.2008 19:45:43
Christian
Hallo Tino,
so sattelfest bin ich nicht bei VBA- habe sozusagen fast keine Ahnung.
Hätte ich mir aber erklären können. Tut mir leid.
Klappt übrigens hervorragend !!! - Danke

AW: Schleifen
15.08.2008 10:33:56
Christian
Hallo Tino,
entschuldige bitte noch einmal.
Du hast ja die Suchkriterien in einem String zusammengeführt. Funktioniert das ganze eigentlich auch, wenn die Kriterien über eine Userform eingegeben werden ?
Ich hatte das bisher in der UserForm so geregelt:
Dim Zugangs_Buchungsbelegnummer, gefunden As Range
Set gefunden = Worksheets("Manteltresor").Range("J10:J5000").Find(Zugangs_Buchungsbelegnummer)
If gefunden Is Nothing Then MsgBox ("Bestand nicht gefunden !"): TextBox7.SetFocus: Exit Sub
gefunden.EntireRow.Cut
With Worksheets("Archiv").Cells(Worksheets("Archiv").Rows.Count, "C").End(xlUp).Offset(1, 0).EntireRow.Insert
und dann bla-bla
hast Du ne Idee ?

Anzeige
AW: Schleifen
15.08.2008 11:41:00
Tino
Hallo,
also wenn diese aus einer Userform z. Bsp. von Textboxen kommen geht dies genau so.
Einfach die die Textboxen aneinanderreihen und diesen Wert als Suchstring verwenden.
Beispiel:
strSuchWert = TextBox1 & TextBox2 & TextBox3 & TextBox4
Sollte funktionieren.
Gruß Tino

AW: Schleifen
15.08.2008 16:43:14
Christian
Hallo Tino nochmals, tut mir leid, ich bekomm`s nicht hin.

Private Sub CommandButton1_Click()
UserForm1.Show
Dim TextBox1 As String
Dim TextBox2 As String
Dim TextBox3 As String
Dim TextBox4 As String
Dim A As Long
Dim strWert As String, strSuchWert As String
'Nur zu Testzwecken (Werte eingefügt)
TextBox1.Value = "4711"
TextBox2.Value = "4812"
TextBox3.Value = "4913"
TextBox4.Value = "5014"
strSuchWert = TextBox1 & TextBox2 & TextBox3 & TextBox4
Application.ScreenUpdating = False
For A = Range("F:J").SpecialCells(xlCellTypeLastCell).Row To 10 Step -1
strWert = Cells(A, "F") & Cells(A, "G") & Cells(A, "H") & Cells(A, "J")
If strWert = strSuchWert Then
With Sheets("Archiv")
Range(Cells(A, "F"), Cells(A, "J")).Copy .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
Rows(Cells(A, "F").Row).Delete
End With
End If
Next A
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Schleifen
15.08.2008 19:20:39
Tino
Hallo,
ich gehe mal davon aus, dass sich dein Commanbutton auf der Userform befindet.
Also ist es besser, diesen Code auch in Deine Userform zu verfrachten.
In die Userform.

Private Sub CommandButton1_Click()
Dim A As Long
Dim strWert As String, strSuchWert As String
strSuchWert = TextBox1 & TextBox2 & TextBox3 & TextBox4
Application.ScreenUpdating = False
For A = Range("F:J").SpecialCells(xlCellTypeLastCell).Row To 10 Step -1
strWert = Cells(A, "F") & Cells(A, "G") & Cells(A, "H") & Cells(A, "J")
If strWert = strSuchWert Then
With Sheets("Archiv")
Range(Cells(A, "F"), Cells(A, "J")).Copy .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
Rows(Cells(A, "F").Row).Delete
End With
End If
Next A
Application.ScreenUpdating = True
End Sub
'Nur zu Testzwecken (Werte eingefügt)
Private Sub UserForm_Activate()
TextBox1.Value = "4711"
TextBox2.Value = "4812"
TextBox3.Value = "4913"
TextBox4.Value = "5014"
End Sub


In Deiner Tabelle erstellst du einen Button und weist diesem ein Makro zum starten der Userform zu.


Private Sub CommandButton1_Click()
UserForm1.Show
End Sub


Gruß Tino

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige