Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1032to1036
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

Makro verbessern

Makro verbessern
24.12.2008 10:24:18
Claudia
Hallo zusammen,
zuerst einmal frohe Weihnachten. Ich hoffe, Ihr werdet reich beschenkt. :-)
Jetzt zu meinem Anliegen. Ich benutze folgendes Makro, um Zeilen, die in der Spalte A den Wert 2 oder 3 haben, in ein anderes Tabellenblatt zu kopieren.

Sub Zeilen_kopieren_wenn_bestimmter_inhalt()
Dim i As Integer
Dim r As Range
j = 5 'Zeile, mit der der Eintrag in der Tabelle beginnen soll
x = Range("c65536").End(xlUp).Row 'letze benutze zeile
For i = 1 To x
If Worksheets(17).Cells(i, 1).Value = 2 Or _
Worksheets(17).Cells(i, 1).Value = 3 Then 'Cells(i,1) bedeutet suche in Spalte A
Worksheets(18).Rows(j).Columns("A:p").Value = Worksheets(17).Rows(i).Columns("A:p").Value
j = j + 1
End If
Next i
Sheets("Ausschnitt MItarbeiter").Select
Range("a1").Select
End Sub


Wie man sieht, muss ich die Suchbegriffe 2 oder 3 hart im Modul verdrahten. Könnt Ihr mir helfen, dass ich die Suchbegriffe in dem Tabellenblatt 18 (dort werden die Werte hinkopiert) eintragen kann, beispielsweise in Zelle A1 und A2?
Das wäre super toll und ein schönes Weihnachtsgeschenk für mich. :-)
Liebe Grüße
Claudia

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

Betreff
Datum
Anwender
Anzeige
AW: Makro verbessern
24.12.2008 10:44:13
Hajo_Zi
Hallo Claudia,
ich würde nicht mit 18 usw arbeiten sondern den Nmaen. Da verändert jemand die Reihenfolge und _ schon muss der Code geädert werden.

Option Explicit
Sub Zeilen_kopieren_wenn_bestimmter_inhalt()
Dim i As Long
Dim J As Long
Dim X As Long
J = 5 'Zeile, mit der der Eintrag in der Tabelle beginnen soll
X = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)  ' _
letze benutze zeile
For i = 1 To X
If Worksheets(17).Cells(i, 1).Value = Worksheets(18).Range("A1") Or _
Worksheets(17).Cells(i, 1).Value = Worksheets(18).Range("A2") Then  'Cells(i,1)  _
bedeutet suche in Spalte A
Worksheets(18).Rows(J).Columns("A:p").Value = Worksheets(17).Rows(i).Columns("A:p"). _
Value
J = J + 1
End If
Next i
Sheets("Ausschnitt MItarbeiter").Select
Range("a1").Select
End Sub



Anzeige
AW: Makro verbessern
24.12.2008 10:48:14
Armin
Hallo Christkind,

Sub Zeilen_kopieren_wenn_bestimmter_inhalt()
Dim i As Integer
Dim r As Range
j = 5 'Zeile, mit der der Eintrag in der Tabelle beginnen soll
x = Range("c65536").End(xlUp).Row 'letze benutze zeile
For i = 1 To x
If Worksheets(17).Cells(i, 1).Value = Worksheets(18).Cells(1, 1).Value Or _
Worksheets(17).Cells(i, 1).Value = Worksheets(18).Cells(2, 1).Value Then 'Cells(i,1) bedeutet  _
suche in Spalte A
Worksheets(18).Rows(j).Columns("A:p").Value = Worksheets(17).Rows(i).Columns("A:p").Value
j = j + 1
End If
Next i
Sheets("Ausschnitt MItarbeiter").Select
Range("a1").Select
End Sub


Der Weihnachtsmann
Armin

Anzeige
AW: Makro verbessern
24.12.2008 10:49:00
Beverly
Hi Claudia,
versuche es mal so:

If Worksheets(17).Cells(i, 1).Value = Worksheets(18).Range("A1") Or _
Worksheets(17).Cells(i, 1).Value = Worksheets(18).Range("A2") Then
Worksheets(18).Rows(j).Columns("A:p").Value = Worksheets(17).Rows(i).Columns("A:p").Value
j = j + 1
End If


Ich hoffe, das ist das Weihnachtsgeschenk, welches du dir gewünscht hast ;-)))



AW: Makro verbessern
24.12.2008 11:11:42
Claudia
Hallo zusammen,
so viele Weihnachtsgeschenke. Vielen lieben Dank an alle!
@ Hajo: Deinen Vorschlag habe ich auch direkt umgesetzt. Ist in der Tat sicherer.
Liebe Grüße und schöne Weihnachtstage
Claudia
Anzeige
AW: Makro verbessern
24.12.2008 11:13:19
Erich
Hallo Claudia,
und noch ein Vorschlag:

Option Explicit                  ' immer zu empfehlen!
Sub Zeilen_kopieren_wenn_bestimmter_inhalt()
Dim lngQ As Long, lngZ As Long, wksZ As Worksheet   ' besser Long als Integer
'  Dim r As Range ? - wird nicht gebraucht
Set wksZ = Worksheets(18)     ' Zielblatt
lngZ = 5                      ' Zeile, mit der der Eintrag in der Tabelle beginnen soll
With Worksheets(17)           ' Quellblatt
For lngQ = 1 To .Cells(.Rows.Count, 3).End(xlUp).Row  ' Zeilen 1 bis letzte benutzte
'Cells(lngQ, 1) bedeutet suche in Spalte A
If .Cells(lngQ, 1).Value = wksZ.Cells(1, 1).Value Or _
.Cells(lngQ, 1).Value = wksZ.Cells(2, 1).Value Then
wksZ.Rows(lngZ).Columns("A:P").Value = .Rows(lngQ).Columns("A:P").Value
lngZ = lngZ + 1
End If
Next lngQ
End With
Sheets("Ausschnitt MItarbeiter").Select
Range("a1").Select
End Sub

Zur Verwendung der Blattindizes 17 und 18 hat Hajo dir ja schon etwas geschrieben.
Das sehe ich auch so.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Makro verbessern
24.12.2008 11:28:05
Claudia
Hallo Erich,
Weihnachten könnte jeden Tag sein. Muss das wohl heute noch ausnutzen und paar dumme Fragen stellen. :-)
Dir danke ich auch für Deinen Vorschlag. Habe ich auch schon ausprobiert.
Liebe Grüße und viele Geschenke
Claudia
und noch ein Geschenk.
24.12.2008 11:36:45
Tino
Hallo,
teste mal diese Version, es wird die letzte Spalte zur Hilfe genommen und eine Formel eingefügt diese wird am Ende wieder gelöscht.
Option Explicit
Sub Zeilen_kopieren_wenn_bestimmter_inhalt()
Dim SBereich As Range
Dim Wert1, Wert2
Dim myCell As Range
Dim LCol As Long
Dim j As Long

Wert1 = Worksheets(18).Range("A1") 'Suchwert 1 
Wert2 = Worksheets(18).Range("A2") 'Suchwert 2 
j = 5

With Application
    .ScreenUpdating = False

            With Worksheets(17)
             Set SBereich = .Range(.Range("A1"), .Cells(.Rows.Count, "C").End(xlUp).Offset(0, -2))
             LCol = SBereich.Column
             Set SBereich = SBereich.Offset(0, .Columns.Count - LCol)
             SBereich.FormulaR1C1 = "=IF(OR(RC1=" & Wert1 & ",RC1=" & Wert2 & "),0,"""")"
             Set SBereich = SBereich.SpecialCells(xlCellTypeFormulas, 1)
             
             For Each myCell In SBereich
              Worksheets(18).Rows(j).Columns("A:P").Value = _
              Worksheets(17).Rows(myCell.Row).Columns("A:P").Value
              j = j + 1
             Next myCell
             
             SBereich.Clear
            End With

        Sheets("Ausschnitt MItarbeiter").Select
        Range("a1").Select
    .ScreenUpdating = True
End With


End Sub


Gruß Tino

Anzeige
AW: und noch ein Geschenk.
24.12.2008 11:51:30
Claudia
Hallo Tino,
Du bist ja verrückt. :-)
Kann Deinen Vorschlag aber erst nach Weihnachten probieren, da ich mich jetzt so langsam fertig machen muss.
Schöne Weihnachten und auch Dir viele Geschenke
Liebe Grüße Claudia
PS: Bist immer sehr hilfsbereit. :-)
Hilfbereit ja, verrückt ein wenig ;-) oT.
24.12.2008 12:03:00
Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige