Entfernen von Apostroph

18.04.2003

Hallo VBA-Spezailisten,

ich suche dringend eine VBA-Variante für die Enfernung des Apostrophs und dem folgenden Leerfeld.

Zum Sachverhalt: z.B. in Zelle BH1 steht folgende Formel:
' =WENN(I16=0;"";WENN(A16=WAHR;$A$14&TEXT(H16;"00");WENN(B16=WAHR;$B$14&TEXT(H16;"00");"EMG1"&TEXT(H16;"00"))))

In Zelle BI1 steht folgende Formel:
' =WENN(H16>0;"EMG1-HD_"&L16&"_"&I16&"_1.tif";WENN(G16=WAHR;Matrix!R4;WENN(F16=WAHR;Matrix!X4;WENN(EMg1!E16=WAHR;Matrix!AD4;WENN(EMg1!D16=WAHR;Matrix!AJ4;WENN(EMg1!C16=WAHR;Matrix!AP4;WENN(EMg1!B16=WAHR;Matrix!AV4;WENN(EMg1!A16=WAHR;Matrix!BB4;L16))))))))

Die Formel aus Zelle BH1 wird per VBA-Makro in Zelle L16 kopiert und von Zelle BI1 die Formel in Zelle M16.

Jetzt kommt das Problem. Das Kopieren per VB-Makro funktioniert. Damit ich die Formel wieder nutzen kann, will ich per Makro natürlich auch in Zelle L16 das Apostroph un die direkt folgende Leerstelle löschen. Nur so steht dann natürlich das Zeichen "=" direkt wieder an erster Stelle in der Zelle.

Frage: Wie ist die Makroanweisung für das Entfernen des Apostrophs und der folgenden Leerstelle, also in Zelle L16 und M16. Mein Makro (per Makrorecorder aufgezeichent) funktioniert nur mit der ersten Zelle, also von BH1 nach L16. Die Formel von Zelle BI1 nach M16, hier läßt sich das Apostroph und das folgende Leerfeld nicht entfernen. Das Makro bricht ab.

Für eine kurzfristige Hilfe sage Danke.

Gruss von m@x

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

19.04.2003

Hallo Rainer, danke für die schnelle Hilfe. Leider bricht das Makro direkt bei "X" von X = RANGE("BH1") ab. Der Cursor steht
dann vor dem "X". Da ich kein Spezi in dem Bereich bin wäre es gut, wenn Du mir die Formel erklären könntest. Ich nehme an, dass ich für "X" die Zielzelle angeben muss. Oder?
Hier gebe ich mal die Info über das gesamte Makro in der ursprünglichen Form (ich hoffe, dass dies nicht zu viel verlangt ist):
Sub FormelInMg1Erneuern()
' Formel restaurieren In Tabelle MG1 SID u. Dateiname
Application.ScreenUpdating = False
ActiveSheet.Unprotect 'Blattschutz öffnen
Range("BH1:BI1").Select
Selection.Copy
Range("L16").Select
ActiveSheet.Paste
Range("L16").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=0,"""",IF(RC[-11]=TRUE,R14C1&TEXT(RC[-4],""00""),IF(RC[-10]=TRUE,R14C2&TEXT(RC[-4],""00""),""EMG1""&TEXT(RC[-4],""00""))))"
Range("M16").Select

' Hier bricht das Makro ab!

ActiveCell.FormulaR1C1 = _
"=RC[-5]>0 ""EMG1-HD_""&RC[-1]&""_""&RC[-4]&""_1.tif"" RC[-6]=TRUE Matrix!R[-12]C[5] RC[-7]=TRUE Matrix!R[-12]C[11] EMg1!RC[-8]=TRUE Matrix!R[-12]C[17] EMg1!RC[-9]=TRUE Matrix!R[-12]C[23] EMg1!RC[-10]=TRUE Matrix!R[-12]C[29] EMg1!RC[-11]=TRUE "

Range("L16:M16").Select
Selection.AutoFill Destination:=Range("L16:M80"), Type:=xlFillDefault
Range("L16:M80").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("H16").Select

' Vorschlag von Rainer
' X = Range("BH1")
'NewX = Right(X, Len(X) - 2)

MsgBox "Die Formeln sind wieder o.K.", vbInformation, "Formel Info"
' löschen der Aktivierung
Range("A1").Select
ActiveCell.FormulaR1C1 = ""
Range("H16").Select
'Blattschutz wird wieder aktiviert
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = False
End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread