Clever-Excel-Forum

Seiten: 1 2 3

Letzter Versuch meinerseits:

Code:
Option Explicit

Sub Kanten_abziehen()

'Kanten abziehne wenn die Kante stärker als das "Max_Fügemaß" ist oder Platte oder Belag nicht gefügt werden kann

Dim LA As Long

Dim vRetP As Variant

Dim vRetBI As Variant

Dim vRetBA As Variant

Dim Abzugsmaß As Long

With Worksheets("Zwischenablage")

   For LA = .Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1

      If Not IsEmpty(.Cells(LA, 3).Value) Then vRetP = Application.IfError(Application.VLookup(.Cells(LA, 3).Value, Range("Lager"), 11, False), "Fehlendes Material")

      If Not IsEmpty(.Cells(LA, 9).Value) Then vRetBI = Application.IfError(Application.VLookup(.Cells(LA, 9).Value, Range("Lager"), 11, False), "Fehlendes Material")

      If Not IsEmpty(.Cells(LA, 8).Value) Then vRetBA = Application.IfError(Application.VLookup(.Cells(LA, 8).Value, Range("Lager"), 11, False), "Fehlendes Material")

       If Left(.Cells(LA, 12).Value, 3) = "KA_" Then

         Abzugsmaß = CLng(Mid(.Cells(LA, 12), InStrRev(.Cells(LA, 12), "X") + 1))

         If Abzugsmaß > Range("Max_Fügemaß").Value Or vRetP <> "x" Or vRetBI <> "x" Or vRetBA <> "x" Then

           .Cells(LA, 19).Value = .Cells(LA, 18).Value - Abzugsmaß

         End If

       End If

   Next LA

End With

End Sub

Vermeide Worksheetfunctions in VBA

Code:
Sub M_snb()

  sn = Tabelle29.Cells(1).CurrentRegion

  sp = Tabelle2.Cells(1).CurrentRegion

  y = Range("Max_Fügemaß").Value

  With CreateObject("scripting.dictionary")

    For j = 1 To UBound(sp)

      .Item(sp(j, 1)) = sp(11)

    Next

    For j = 1 To UBound(sn)

      If Left(sn(j, 12), 3) = "KA_" Then

        sq = Split(sn(j, 12), "_")

        If Val(sq(UBound(sq))) > y Or .Item(sn(j, 3)) <> "x" Or .Item(sn(j, 8)) <> "x" Or .Item(sn(j, 9)) <> "x" Then sn(j, 19) = sn(j, 18) - Val(sq(UBound(sq)))

      End If

    Next

  End With

End Sub

Hallo snb,
vielen dank für deinen Vorschlag.
Ich habe es eingelesen und leider zeigt es mit einen fehler an

"Sub oder Funktion nicht definiert"

Wo leigt hier der Fehler?

Hallo Earlfred,
vielen Dank für ein letztes aufbäumen.

Code:
 For LA = .Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1

Leider ziegt es mir bei der Zeile einen Syntaxfehler an.
Ich habe die Zeile mit den Bestehenden verglichen. Habe dann gesehen das der "." zu viel ist. Wenn ich den lösche zeigt es mir die Meldung an "Fehler beim Kompelieren" "Erwartet: Anweisungsende"

Hier bin ich nicht weiter gekommen. Vermutlich ein Klax zum beheben. Ich selber komme leider hier nicht weiter.

Hallo EarlFred,
Danke für die Info zum Thema Hygiene. Ich selber kann die Schnippsel welche ich für diese Codes aus dem Internet zusammen suche leider schlecht bewerten. Da gehe ich doch zu leihenhaft vor. Aber solche Basics sind Gold wert.

Entschuldige meine "schwammigen Antworten" hier fehlt mir eure Denkweise. An und für sich sollte keine falsche Materialdefinfition rein kommen. Da die Überprüfung der Richtigen schreibweise nur über eine Bedingte Formatierung mit einfärben der Zelle funktionier ist also doch nichts unmöglich.
Sollte sich keine Übereintreffung finden ist das kleiner Übel das hier nichts geschiet. Eine aufplopende Fehlermeldung wäre trozdem sehr brauchbar. Von dem Maß soll nichts abgezogen werden.

Ich danke dir für deine Gedult

Hallo Schauan,

Zitat:nicht MsgBox vRetP = ... sondern nur MsgBox vRetP

ein Leichtsinsfehler Undecided

Ich kann dir bestätigen, dass mein Code einwandfrei in der Mustermappe funktioniert. Der Punkt muss auch sein, um ordentlich zu referenzieren (Bezug zum With-Block).

Ich vermute also, dass der Code von Dir geändert wurde, was ich allerdings inhaltlich aus der Ferne schlecht bewerten kann.

@Leg

Feedback sollte immer sinnvoll sein.
Verwende im VBEditor F8 und berichte in welcher Zeile der Fehler auftritt.

Hallo Snb,
vielen Dank für die neue Fassung.

Zwei dinge sind mir aufgefallen:
- In der Spalte F wird ab Zeile 5 immer das Maß "X" abgezogen.
- Es wird nicht berücksichtigt ob das Material bei Fügen ein X hat. (Spalte 11, Lager)
- Es wird immer 23mm abgezogen. Hier wird aus dem Materialcodes aus den Spalten 10-13 vermutlich immer der Falsche Teil ausgeschnitten.

Code:
'Kanten abziehne wenn die Kante stärker als das "Max_Fügemaß" ist oder Platte oder Belag nicht gefügt werden kann

  sn = Worksheets("zwischenablage").Cells(1).CurrentRegion

  sp = Worksheets("Lager").Cells(1).CurrentRegion

  y = Range("Max_Fügemaß").Value '-> Entspricht aktuell "2"

  With CreateObject("scripting.dictionary")

    For jj = 2 To UBound(sp)

      If sp(jj, 11) <> "x" Then .Item(sp(jj, 1)) = sp(jj, 11)

    Next

    For jj = 1 To UBound(sn)

      If Left(sn(jj, 12), 3) = "KA_" Then

        sq = Split(sn(jj, 12), "_")

        If Val(sq(UBound(sq))) > y Or .exists(sn(jj, 3)) Or .exists(sn(jj, 8)) Or .exists(sn(jj, 9)) Then sn(jj, 5) = sn(jj, 5) - Val(sq(UBound(sq)))

      End If

    Next

  End With

    With CreateObject("scripting.dictionary")

    For jj = 2 To UBound(sp)

      If sp(jj, 11) <> "x" Then .Item(sp(jj, 1)) = sp(jj, 11)

    Next

    For jj = 1 To UBound(sn)

      If Left(sn(jj, 13), 3) = "KA_" Then

        sq = Split(sn(jj, 13), "_")

        If Val(sq(UBound(sq))) > y Or .exists(sn(jj, 3)) Or .exists(sn(jj, 8)) Or .exists(sn(jj, 9)) Then sn(jj, 5) = sn(jj, 5) - Val(sq(UBound(sq)))

      End If

    Next

  End With

    With CreateObject("scripting.dictionary")

    For jj = 2 To UBound(sp)

      If sp(jj, 11) <> "x" Then .Item(sp(jj, 1)) = sp(jj, 11)

    Next

    For jj = 1 To UBound(sn)

      If Left(sn(jj, 10), 3) = "KA_" Then

        sq = Split(sn(jj, 10), "_")

        If Val(sq(UBound(sq))) > y Or .exists(sn(jj, 3)) Or .exists(sn(jj, 8)) Or .exists(sn(jj, 9)) Then sn(jj, 6) = sn(jj, 6) - Val(sq(UBound(sq)))

      End If

    Next

  End With

    With CreateObject("scripting.dictionary")

    For jj = 2 To UBound(sp)

      If sp(jj, 11) <> "x" Then .Item(sp(jj, 1)) = sp(jj, 11)

    Next

    For jj = 1 To UBound(sn)

      If Left(sn(jj, 11), 3) = "KA_" Then

        sq = Split(sn(jj, 11), "_")

        If Val(sq(UBound(sq))) > y Or .exists(sn(jj, 3)) Or .exists(sn(jj, 8)) Or .exists(sn(jj, 9)) Then sn(jj, 6) = sn(jj, 6) - Val(sq(UBound(sq)))

      End If

    Next

  End With

  'Worksheets("zwischenablage").CurrentRegion = sn

Den Code habe ich mal entsprechend an meine Bereiche angepasst.

Beim abspielen wurde mir die letzte Zeile nicht genommen. Deswegen habe ich Sie mal ausgeschaltet
Die Bereiche in denen zum Ende hin immer das Maß abgezogen werden soll konnte ich nicht ändern (19 anstatt 5 und 20 anstatt 6). Hier kommt dann die Fehlermeldung "Index außerhalb des gultigen Bereichs"

Der Code hat leider nichts in meiner Liste geändert. Das Muster habe ich aus der origignal Datei erstellt.

Ich bin ein wenig verweifelt Huh

Hallo EarlFred,

anbei ein Screenshot wie es aussihet wenn ich es in die originale Datei oder auch in die Musterdatei einlese.

Code:
For LA = .Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1

Diese Zeile wird rot gefärbt und es kommt beim durchlaufen des Codes die Meldung Syntaxfehler.

Kann es an grundlegenden Einstellungen von Excel liegen?

Zitat:- Es wird nicht berücksichtigt ob das Material bei Fügen ein X hat. (Spalte 11, Lager)

Stimmt nicht; du hast den Code nicht verstanden.

Zitat:- Es wird immer 23mm abgezogen. Hier wird aus dem Materialcodes aus den Spalten 10-13 vermutlich immer der Falsche Teil ausgeschnitten.

Verrate mal was abgezogen werden müsste.
Was ist das 'richtige' Teil ?

Hallo snb,

Zitat:Stimmt nicht; du hast den Code nicht verstanden.

Das mag ich jetzt nicht bestreiten. Das Resultat zeigt aber das hier das Maß nicht abgezogen wird. Wenn im Material das "X" Fehlt muss das Maß der Kante (Spalte 10-13) abgezogen werden.

(Wird das Material nicht gefunden soll nichts abgezogen werden)

Zitat:Verrate mal was abgezogen werden müsste.

Was ist das 'richtige' Teil ?

Wenn eines der Materialien aus der Spalte 3,8 oder 9 das "x" hat soll das Maß des Kantenmaterials aus der Spalte (10-13) abgezogen werden.

Hier möchte ich jede Kante/Spalte einzeln abarbeiten.
Das Maße was abzuziehen ist, sind von rechts nach links die Ziffen bis zum ersten "x" ("KA_W980_ST15_23X02" -> "02")
Diese 02mm sollen dann dementsprechend von dem Maß aus der Spalte 19 oder 20 abgezogen werden.

Ich hoffe du kannst damit was Anfange.
Vielen Dank schon mal für deine Hilfe!

Eine Musterdatei wäre sinnvoller als das Bild.
Schreib die Zeile mal von Hand neu, vielleicht hat sich beim Kopieren ein Steuerzeichen versteckt.

Hallo Zusamme,
jetzt hat es doch etwas gedauert bis ich zur Umsetztung gekommen bin.
Ich habe mich nochmals hin gesetzt und mit euren Vorschlägen gebastelt.

Daraus habe ich jetzt eine läsung erstellt die für mich geht. Entschudligt wenn es so aussieht das es sehr deletantisch zusammen gebalstelt ist.

Code:
'Kanten abziehne wenn die Kante stärker als das "Max_Fügemaß" ist oder Platte oder Belag nicht gefügt werden kann

    Dim LA As Integer

    For LA = Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1

    Dim vRetP As Variant

    Dim vRetBI As Variant

    Dim vRetBA As Variant

    vRetP = Application.IfError(Application.VLookup(Worksheets("zwischenablage").Cells(LA, 3), Worksheets("Lager").Range("A2:K1048576"), 11, False), "x")

    vRetBI = Application.IfError(Application.VLookup(Worksheets("zwischenablage").Cells(LA, 8), Worksheets("Lager").Range("A2:K1048576"), 11, False), "x")

    vRetBA = Application.IfError(Application.VLookup(Worksheets("zwischenablage").Cells(LA, 9), Worksheets("Lager").Range("A2:K1048576"), 11, False), "x")

    If Left(Cells(LA, 12).Value, 3) = "KA_" Then

        If CDec(Mid(Cells(LA, 12), InStrRev(Cells(LA, 12), "X") + 1)) > Range("Max_Fügemaß") Or _

        vRetP <> ("x") Or _

        vRetBI <> ("x") Or _

        vRetBA <> ("x") Then

        Cells(LA, 19).Value = Cells(LA, 19) - Mid(Cells(LA, 12), InStrRev(Cells(LA, 12), "X") + 1)

        End If

    End If

    If Left(Cells(LA, 13).Value, 3) = "KA_" Then

        If CDec(Mid(Cells(LA, 13), InStrRev(Cells(LA, 13), "X") + 1)) > Range("Max_Fügemaß") Or _

        vRetP <> ("x") Or _

        vRetBI <> ("x") Or _

        vRetBA <> ("x") Then

        Cells(LA, 19).Value = Cells(LA, 19) - Mid(Cells(LA, 13), InStrRev(Cells(LA, 13), "X") + 1)

        End If

    End If

    If Left(Cells(LA, 10).Value, 3) = "KA_" Then

        If CDec(Mid(Cells(LA, 10), InStrRev(Cells(LA, 10), "X") + 1)) > Range("Max_Fügemaß") Or _

        vRetP <> ("x") Or _

        vRetBI <> ("x") Or _

        vRetBA <> ("x") Then

        Cells(LA, 20).Value = Cells(LA, 20) - Mid(Cells(LA, 10), InStrRev(Cells(LA, 10), "X") + 1)

        End If

    End If

    If Left(Cells(LA, 11).Value, 3) = "KA_" Then

        If CDec(Mid(Cells(LA, 11), InStrRev(Cells(LA, 11), "X") + 1)) > Range("Max_Fügemaß") Or _

        vRetP <> ("x") Or _

        vRetBI <> ("x") Or _

        vRetBA <> ("x") Then

        Cells(LA, 20).Value = Cells(LA, 20) - Mid(Cells(LA, 11), InStrRev(Cells(LA, 11), "X") + 1)

        End If

    End If

    Next LA

    LA = Empty

    vRetP = Empty

    vRetBI = Empty

    vRetBA = Empty

Danke für eure Hilfe und die Gedult.

Schönes Wochenende
Flo

Seiten: 1 2 3

26865

snb

legiminator

26865

snb

legiminator

snb

legiminator

26865

legiminator