Teilwert einer Zelle auslesen und zu anderem Teilwert einen vorgegebenen Wert addiere

[Valeverde]

Hallo Forumsnutzer,

ich habe eine Frage zum Auslesen von Teilwerten einer Zelle und deren Weiterverarbeitung und weiss auch gar nicht ob das so überhaupt möglich ist.

Die Tabelle hat über 40.000 Zeilen und 9 Spalten.
In verschiedenen Zellen stehen werde die mit "Z" oder "Z-" beginnen, nach Z oder Z- stehen dann noch Zahlenwerte.
Jetzt hätte ich gerne die ganzen Werte in ein neues Tabellenblatt übertragen und dabei soll bei allen Zellen in denen "Z" oder "Z-" enthalten ist der Zahlenwert ausgelesen werden und jeweilst mit einem vorgegebenen wert addiert werden.

Beispiel:
Zellwert: "Z400." --> Addierungswert - 660 --> Ergebnis in neuer Zelle auf neuem Tabellenblatt "Z1060."

Bei Minuswerten - Beispiel:
Zellwert: "Z-400." --> Addierungswert - 660 --> Ergebnis in neuer Zelle auf neuem Tabellenblatt "Z260."


Anbei die Excelliste:

  Werte.xlsx (Größe: 1,01 MB / Downloads: 5)

Vielen Dank für die Hilfe

[Kl@us-M.]

Hi,

brauchst Du den Punkt am Ende des Strings oder kann der wegfallen ?

[Valeverde]

Hi,

der Punkt steht für die Maschine welche die Datei dann einlesen soll für ein Komma und wird nur dann benötigt wenn hinter dem Punkt noch weitere Zahlen stehen, was auch
vorkommen kann.

allso "Z400." +660 darf dann "Z1060" sein
aber "Z400.50" sollte dann bei +660 "Z1060.50" sein.

[shift-del]

Hallo

Code:

="Z"&WECHSELN(WECHSELN(WECHSELN(A1;"Z";"");".";",")+660;",";".")

[chris-ka]

Hi,

teste das mal in einer Kopie der Mappe...
aber Garantie gibt es keine, wenn das auf eine Maschine soll und knallt!

Code:

Sub stantiv()
Dim rng As Range, rng_cell As Range, lngCalc As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    On Error GoTo errmsg
    Cells.NumberFormat = "General"
    Cells.Replace What:="Z", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Set rng = Cells.SpecialCells(xlCellTypeConstants, 1)
    Range("M1").Value = 660 'anpassen
    Range("M1").Copy
    With rng
    .PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    For Each rng_cell In rng
        rng_cell.Value = "Z" & Format(rng_cell, "0.#####")
    Next
    End With
    Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Range("M1").Value = ""
    Set rng = Nothing
    Set rng_cell = Nothing
errmsg:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lngCalc
        .DisplayAlerts = True
    End With
If Err.Number <> 0 Then MsgBox Err.Number & " / " & Err.Description
End Sub

mit . am Ende

[Valeverde]

Hallo,

Super Danke,

Die Zellen mit Z werden alle berechnet.
Jetzt bräuchte ich noch das alle anderen Werte ohne Z im Original ohne Veränderung übernommen  werden.
Habe die Liste noch mal mit der eingefügten Formel angehängt:

  Werte.xlsx (Größe: 1,01 MB / Downloads: 2)

Code:

="Z"&WECHSELN(WECHSELN(WECHSELN(A1;"Z";"");".";",")+660;",";".")

[Valeverde]

Hallo Chris,

den code probiere ich auch gleich aus - Danke dafür

[shift-del]

Jetzt bräuchte ich noch das alle anderen Werte ohne Z im Original ohne Veränderung übernommen  werden.

Code:

=WENNFEHLER("Z"&WECHSELN(WECHSELN(WECHSELN(A1;"Z";"");".";",")+660;",";".");A1)

[Valeverde]

Hallo Chris,

der Code ist perfekt, macht genau das was wir wollten.

Vielen Dank dafür

Ich gehe das mit meinen Kollegen jetzt durch und wir schauen ob sich die Maschine genauso freut.

Melde mich dann noch mal...

[Valeverde]

Hallo,

es hat alles super geklappt.

Noch mal vielen Dank für die Lösung.

Alles Gute...