hi!
zunächst einmal danke für deine hilfe!
dass das eine eigenständige sub sein kann, weiß ich. bei mir is das jedoch nur eine funktion in einer sub. sie muss keinen wert zurückgeben. sollte ich das dann als sub oder funktion nehmen? in meiner sub werden, nach aufruf eines buttons, mehrere funktionen durchlaufen, daher dachte ich, dass es so besser ist.
sub erstellen ()
daten_löschen
daten_übertragen
end sub
dass excel mit dem select befehl langsamer läuft, wusste ich nicht, aber irgendwie muss ich die zelle ja ansprechen. wenn es geht, werde ich deinen code benutzen.
zu meinem problem: mir war schon klar, dass da etwas nicht stimmt, nur kam ich nicht darauf. mittlerweile habe ich es so gelöst:
Function Daten_Übertragen()
Dim i As Integer
Dim j As Integer
Sheets("Übersicht").Select 'Thema aus "Übersicht" in "Roadmap" übertragen
i = 2
j = 5
Do While IsEmpty(Cells(i, 1)) = False 'wenn Zellen nicht leer, dann
If j > 20 Then 'wenn Auswahl zu groß, dann
Sheets("Roadmap").Select
MsgBox ("Ihre Auswahl in der Übersichtstabelle hat die maximale Anzahl von 15 Einträgen erreicht. Kürzen Sie Ihre Auswahl entsprechend!")
'Exit Function
End If
If Rows(i).Hidden = True Then 'wenn Zellen ausgeblendet, dann überspringen aber mitzählen
i = i + 1
ElseIf Rows(i).Hidden = False Then 'wenn Zellen nicht ausgeblendet, dann
'Wert der aktuell ausgewählten Zelle wird in Zielzelle in "Roadmap" übertragen
Sheets("Roadmap").Cells(j, 3).Value = Sheets("Übersicht").Cells(i, 1)
If Cells(i, 2) = "abc" Then 'Wenn Zelle = "abc", übertrage den Wert "1" in Zielzelle in "Roadmap"
Sheets("Roadmap").Cells(j, 2).Value = "1"
ElseIf Cells(i, 2) = "def" Then
Sheets("Roadmap").Cells(j, 2).Value = "3"
End If
i = i + 1 'Zellen in "Übersicht" und "Roadmap" um jeweils 1 erhöhen
j = j + 1
End If
Loop
Sheets("roadmap").Select 'Hintergrund Spalte 2 nach Marke einfärben
i = 5
Do While IsEmpty(Cells(i, 2)) = False 'Wenn ausgewählte Zelle in "Roadmap" nicht leer, dann
If Cells(i, 2).Value = "1" Then 'Wenn ausgewählte Zelle den Wert "1" hat, dann mit "abc"-Farben ausfüllen
Cells(i, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 11250084
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ElseIf Cells(i, 2).Value = "3" Then
Cells(i, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13884121
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Function
mit diesem code macht er alles das, was ich will :)
was sagst du als profi dazu? ;)
den trick mit dem ermitteln der letzten zeile werde ich mir aber merken! das werde ich sicherich im weiteren verlauf dieser datei noch brauchen! vielen dank :)
schöne grüße
|