Per VBA werte kopieren - nicht die Formel
27.06.2012 09:41:45
Nimzo
Hallo Matthias
auf meinem HomePC mit OFFICE 2010 ging alles problemlos. Jetzt bin ich gerade mit dem Zug unterwegs und auf meinem Laptop (OFFICE 2007) funktioniert es nicht.
(noch die von Dir gemacht Version (also ohne die ComboBox3_Change sub)
Ich bekomme folgende Fehlermeldugn:
"Laufzeitfehler '457:
Dieser Schlüssel ist bereits einem Element dieser Auflistung zugeordnet"
Beim Debuggen wird aus nachfolgendem Code die Zeile : "col.Add Sheets("Mannschaftskombi").Cells(iRow, 2), Sheets("Mannschaftskombi").Cells(iRow, 2)"
For iRow = 2 To ALetzte
If Not IsEmpty(Sheets("Mannschaftskombi").Cells(iRow, 2)) Then
If Sheets("Mannschaftskombi").Cells(iRow, 2) = ComboBox1.Value Then
col.Add Sheets("Mannschaftskombi").Cells(iRow, 2), Sheets("Mannschaftskombi"). _
Cells(iRow, 2)'Diese Zeile wird beim Debugen angezeigt
ComboBox2.AddItem Sheets("Mannschaftskombi").Cells(iRow, 3)
End If
End If
Next iRow
Hier nochmals der gesamte Code:
Option Explicit
Private Sub UserForm_Activate()
' Das sind nur Spieldaten, hier kommt dein Quelltext zum Befüllen
' det ComboBox1 rein !!!
ComboBox1.List = Sheets("Mannschaftskombi").Range("A2:A11").Value
End Sub
Sub Sortieren()
Dim Letzter As Integer, Naechster As Integer
Dim i As String
With ComboBox2
For Letzter = 0 To .ListCount - 1
For Naechster = Letzter + 1 To .ListCount - 1
If .List(Letzter) > .List(Naechster) Then
i = .List(Letzter)
.List(Letzter) = .List(Naechster)
.List(Naechster) = i
End If
Next Naechster
Next Letzter
End With
End Sub
Private Sub ComboBox1_Change()
' geschrieben von P@ulchen, angepasst von Klaus-Dieter
Dim col As New Collection, X&
Dim iRow As Long, ALetzte As Long
ComboBox2.Clear
ALetzte = IIf(IsEmpty(Sheets("Mannschaftskombi").Range("c65536")), Sheets("Mannschaftskombi" _
).Range("c65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 2 To ALetzte
If Not IsEmpty(Sheets("Mannschaftskombi").Cells(iRow, 2)) Then
If Sheets("Mannschaftskombi").Cells(iRow, 2) = ComboBox1.Value Then
col.Add Sheets("Mannschaftskombi").Cells(iRow, 2), Sheets("Mannschaftskombi"). _
Cells(iRow, 2)
ComboBox2.AddItem Sheets("Mannschaftskombi").Cells(iRow, 3)
End If
End If
Next iRow
On Error GoTo 0
Call Sortieren
ComboBox2.ListIndex = 0
'Spieler holen für Combobox1
ComboBox3.Clear 'alte Einträge löschen
ComboBox4.Clear 'alte Einträge löschen
ComboBox5.Clear 'alte Einträge löschen
For X = 2 To 31
With Tabelle3 'CodeName der Tabelle("Spieler")
If .Cells(X, 1) = ComboBox1 Then
ComboBox3.AddItem .Cells(X, 2)
ComboBox4.AddItem .Cells(X, 2)
ComboBox5.AddItem .Cells(X, 2)
End If
End With
Next
End Sub
Private Sub ComboBox2_Change()
Dim X&
'Spieler holen für Combobox1
ComboBox6.Clear 'alte Einträge löschen
ComboBox7.Clear 'alte Einträge löschen
ComboBox8.Clear 'alte Einträge löschen
For X = 2 To 31
With Tabelle3 'CodeName der Tabelle("Spieler")
If .Cells(X, 1) = ComboBox2 Then
ComboBox6.AddItem .Cells(X, 2)
ComboBox7.AddItem .Cells(X, 2)
ComboBox8.AddItem .Cells(X, 2)
End If
End With
Next
End Sub
Könntest Du mir nochmals helfen?
Viele Grüsse
Nimzo