Wort durch Symbol ersetzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Range) Dim rngZelle As Range If Target.Address = "$A$1" Then Set rngZelle = Worksheets("Tabelle2").Columns(1).Find(Target, lookat:=xlWhole) If Not rngZelle Is Nothing Then Application.EnableEvents = False Target = rngZelle.Offset(0, 1) Application.EnableEvents = True End If Set rngZelle = Nothing End If End Sub

Hallo Beverly. Kannst Du mir den Code bitte erklären? Ich steig da nicht so recht dahinter (zumal er nicht funktioniert...)!
Die Zellen, die von der Umstellung betroffen sind, werden durch eine Schleife ermittelt...
Ich füge unten mal den code vom Projekt ein. Wichtig ist das einfügen des Events. Ich trage momentan einfach den Namen des events dort ein und wollte im abschliessenden Schritt den Namen(das wort) gegen ein Symbol tauschen. Natürlich kann man das auch gleich machen...nur nacheinander ist es nicht so verschachtelt. :-)

Sub zeilenabgrasen()
Dim zeile As Long
'Dim monat As Date
Dim datum As Date
Dim jahr As Integer
'#PCP FESTLEGEN#
For i = 2 To ThisWorkbook.Worksheets(1).Cells(2, 4).End(xlDown).Row
PCP = ThisWorkbook.Worksheets(1).Cells(i, 4).Value
Set zeilepcp = ThisWorkbook.Worksheets(2).Columns(4).Find(what:=PCP, lookat:=xlWhole, LookIn:= _
xlValues)
For zeile = 23 To ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, 2) _
.End(xlUp).Row
If Worksheets(1).Cells(zeile, 4).Value = PCP Then 'WENN PCP-WERT GEFUNDEN WURDE....
'#Datum kopieren#
datum = CDate(Worksheets(1).Cells(zeile, 2))
jahr = Format(datum, "YYYY") 'Jahr prüfen
monat = Choose(Month(datum), "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", _
"Aug", "Sep", "Oct", "Nov", "Dec") 'englisches Monatskürzel
Set spaltemonat = ThisWorkbook.Worksheets(2).Rows(5).Find(what:=monat, lookat:=xlWhole,  _
LookIn:=xlValues)
ThisWorkbook.Worksheets(2).Cells(zeilepcp.Row, spaltemonat.Column) = datum
'#Gate kopieren#
ThisWorkbook.Worksheets(1).Cells(zeile, 6).Copy
ThisWorkbook.Worksheets(2).Cells(zeilepcp.Row + 2, spaltemonat.Column).PasteSpecial  _
Paste:=xlPasteAllExceptBorders
'#EVENT kopieren#
ThisWorkbook.Worksheets(1).Cells(zeile, 7).Copy
ThisWorkbook.Worksheets(2).Cells(zeilepcp.Row + 1, spaltemonat.Column).PasteSpecial  _
Paste:=xlPasteAllExceptBorders
End If
Next
Next
End Sub

Sorry für die zum Teil noch fehlende Variablendeklaration und unnötig lange Ausdrücke - ich bin ja noch nicht fertig und ausgeschriebene Codezeilen helfen den Überblick zu behalten....:-)
gruß Beffen

Dim picBild As Picture For Each picBild In Worksheets("Tabelle2").Pictures If picBild.TopLeftCell.Address = rngZelle.Offset(0, 1).Address Then picBild.Copy With Worksheets("Tabelle1") .Paste .Pictures(.Pictures.Count).Top = .DeineLaufendeZelle.Top .Pictures(.Pictures.Count).Left = .DeineLaufendeZelle.Left End With Exit For End If Next picBild

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread