Probleme mit Variabler

Hallo,
ich habe in einem Makro ein Problem. Es dient dazu die Spieltermine von Mannschaften geordnet in das Tabellenblatt "Spiele" einzutragen Anbei ein Ausschnitt:
...
Dim M As String
Dim z As Integer
Sheets("Serie").Activate
Cells.EntireRow.Hidden = False
letztezeile = ActiveSheet.Cells(65536, 4).End(xlUp).Row
M = "Mannschaft V"
...
In der Ursprungstabelle "Serie" stehen in Spalte 4 und Spalte 5 die Mannschaften. Dort gibt es auch die Begegnung "Mannschaft V" gegen "Mannschaft VI" und da liegt der Hase im Pfeffer.
Excel kopiert aus der Ursprungstabelle "Serie" falsch in das Tabellenblatt "Spiele", indem es die Zeile mit der Begegnung der "Mannschaft V" und der "Mannschaft VI" wegläßt. Anscheinend ist die Variable "M" nicht genau genug, bzw. tritt ja in einer Zeile im Blatt "Serie" der gesuchte Ausdruck zweimal auf (in Zeile 10, in Spalte 4 steht "Mannschaft V" und in derselben Zeile in Spalte 5 dann "Mannschaft VI".
Gibt es die Möglichkeit, die Variable "M" erweitert/genauer zu formulieren, in etwa so: M = "Mannschaft V" And not "Mannschaft VI"? Oder geht das mit "Find" exakter?
Hilfe wäre nett.
Grüße
Burghard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Mannschaften() On Error GoTo nix Application.ScreenUpdating = False Dim M As String Dim z As Integer Sheets("Serie").Activate Cells.EntireRow.Hidden = False letztezeile = ActiveSheet.Cells(65536, 4).End(xlUp).Row M = "Mannschaft V" For z = 3 To letztezeile Step 1 If Cells(z, 4).Value M And Cells(z, 5).Value M Then Cells(z, 4).EntireRow.Hidden = True End If Next z Sheets("Serie").Range("A4:F" & Sheets("Serie").UsedRange.Rows.Count). _ SpecialCells(xlCellTypeVisible).Copy Sheets("Spiele").Activate z = 1 Do While Len(Worksheets("Spiele").Cells(z, 1)) > 0 'Ermitteln der Tabellenlänge z = z + 1 Loop Range("A" & z).Select ActiveSheet.Paste Letzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Range("A" & Letzte + 1) = " " Sheets("Serie").Activate Cells.EntireRow.Hidden = False letztezeile = ActiveSheet.Cells(65536, 4).End(xlUp).Row M = "Mannschaft VI" For z = 3 To letztezeile Step 1 If Cells(z, 4).Value M And Cells(z, 5).Value M Then Cells(z, 4).EntireRow.Hidden = True End If Next z Sheets("Serie").Range("A4:F" & Sheets("Serie").UsedRange.Rows.Count). _ SpecialCells(xlCellTypeVisible).Copy Sheets("Spiele").Activate z = 1 Do While Len(Worksheets("Spiele").Cells(z, 1)) > 0 'Ermitteln der Tabellenlänge z = z + 1 Loop Range("A" & z).Select ActiveSheet.Paste Letzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Range("A" & Letzte + 1) = " " Sheets("Serie").Activate Cells.EntireRow.Hidden = False letztezeile = ActiveSheet.Cells(65536, 4).End(xlUp).Row ActiveSheet.Range("A" & letztezeile).Select Sheets("Serie").Cells.EntireRow.Hidden = False Application.CutCopyMode = False Application.ScreenUpdating = True nix: End Sub

Hallo Burghard,
funktionieren tut der Code schon, ich habe ihn so wie du ihn hier eingestellt hast probiert. Vermutlich stimmt dann etwas mit deinen Daten in der Tabelle nicht -Leerzeichen vor bzw. nach dem Namen-. Das bekommst du mit der Methode die Gerd vorgeschlagen hat in den Griff.
Aber mal ne ganz andere Frage. Was hast du eigentlich vor. So wie ich das sehe hast du in der Tabelle "Serie" Spielpaarungen in den Spalten 4 und 5 drin. Die kopierst du dann in Blöcken nach den einzelnen Mannschaften in die Tabelle "Spiele", jeweils mit einer Leerzeile zwischen den verschiedenen Mannschaften.
Willst du das, wie in deinem Code angedeutet, für mehrere Mannschaften machen und den Code für jede Mannschaft kopieren? Wenn ich jetzt mal von der Bundesliga ausgehe dann müsstest du den Code 18 mal kopieren.
Ich habe dir mal ein kleines Beispiel gebastelt. Kannst ja mal testen -aber natürlich nicht mit deiner Originaldatei-.
Dazu bitte noch ein weiteres Tabellenblatt "Mannschaften" anlegen. In Spalte A ab A1 schreibst du die einzelnen Mannschaften (für die du die Spielpaarungen im Blatt "Serie" stehen hast) untereinander weg. Für die Bundesliga wären das dann 18 Mannschaften. Der Code läuft dann in einer Schleife über diese Mannschaftsliste und kopiert dann die Spielpaarungen der jeweiligen Mannschaft aus dem Blatt "Serie" ins Blatt "Spiele". Kannst es dir ja mal anschauen.

Public Sub Mannschaften()
Dim strTeam As String
Dim loLetzteQ As Long 'letzte Quellblatt
Dim loLetzteZ As Long 'letzte Zielblatt
Dim loLetzteM As Long 'letzte Blatt Mannschaften
Dim i As Long
Dim z As Long
loLetzteQ = Sheets("Serie").Cells(Rows.Count, 4).End(xlUp).Row 'letzte Quellblatt
loLetzteM = Sheets("Mannschaften").Cells(Rows.Count, 1).End(xlUp).Row 'letzte Mannschaften
Application.ScreenUpdating = False 'Bildschirmaktualisierung aus
For z = 1 To loLetzteM
strTeam = Sheets("Mannschaften").Cells(z, 1).Value
With Sheets("Serie")
For i = loLetzteQ To 4 Step -1
If Trim$(.Cells(i, 4).Value)  strTeam And _
Trim$(.Cells(i, 5).Value)  strTeam Then
.Cells(i, 4).EntireRow.Hidden = True
End If
Next i
End With
On Error Resume Next
With Sheets("Serie")
loLetzteZ = Sheets("Spiele").Cells(Rows.Count, 1).End(xlUp).Row + 3 'letzte Zielblatt
If loLetzteZ = 4 Then loLetzteZ = loLetzteZ - 1
Sheets("Spiele").Cells(loLetzteZ - 1, 4) = "Spiele von " & strTeam
Sheets("Spiele").Cells(loLetzteZ - 1, 4).Font.Bold = True
.Range("A4:F" & loLetzteQ).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Spiele").Cells(loLetzteZ, 1)
End With
Sheets("Serie").Cells.EntireRow.Hidden = False
Next z
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread