Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Schleifen

Betrifft: Schleifen von: Christian
Geschrieben am: 11.08.2008 20:02:19

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

  

Betrifft: AW: Schleifen von: Chris b.
Geschrieben am: 11.08.2008 20:11:16

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


  

Betrifft: AW: Schleifen von: Chris b.
Geschrieben am: 11.08.2008 20:14:08

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 12.08.2008 14:36:47

Hallo Chris,

hast Du dafür mal ein Beispiel ? Oder kannst Du mir das verbasteln und hochladen ?

Gruß Christian


  

Betrifft: AW: Schleifen von: Tino
Geschrieben am: 11.08.2008 20:27:39

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 12.08.2008 14:30:56

Hallo Tino,

funktioniert leider nicht - hast Du noch `ne andere Lösung ?

Gruß Christian


  

Betrifft: AW: Schleifen von: Tino
Geschrieben am: 12.08.2008 20:50:53

Hallo,
könntest du bitte etwas genauer werden, und auch sagen was nicht geht?

Gruß Tino


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 13.08.2008 08:32:44

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 13.08.2008 08:47:10

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


  

Betrifft: AW: Schleifen von: Tino
Geschrieben am: 13.08.2008 15:44:38

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 13.08.2008 19:45:43

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 15.08.2008 10:33:56

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 ?


  

Betrifft: AW: Schleifen von: Tino
Geschrieben am: 15.08.2008 11:41:12

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


  

Betrifft: AW: Schleifen von: Christian
Geschrieben am: 15.08.2008 16:43:14

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




  

Betrifft: AW: Schleifen von: Tino
Geschrieben am: 15.08.2008 19:20:39

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