Kreuzpreis ermitteln und multiplizieren

Dieses Thema Kreuzpreis ermitteln und multiplizieren im Forum "Windows XP Forum" wurde erstellt von Seflere, 28. Feb. 2005.

Thema: Kreuzpreis ermitteln und multiplizieren Hallo zusammen, ich habe folgendes, für mich unlösbares Problem: Ich habe eine Tabelle welche in der ersten Zeile...

  1. Hallo zusammen,

    ich habe folgendes, für mich unlösbares Problem:

    Ich habe eine Tabelle welche in der ersten Zeile (B1 : L1) Kilometerangaben stehen hat(Bsp. bis 100km, bis 200km, ...). In der Spalte A (A2 : A14) stehen Gewichtsangaben (Bsp. 1 -50 kg, 51 - 100 kg, ...). In der daraus entstehenden Tabelle ist unter bzw. jedem km- bzw. kg-Wert ein Betrag eingetragen. Ich möchte nun in zwei Zellen unterhalb der Tabelle lediglich eine Kilometerangabe und eine Gewichtsangabe machen und Excel soll mir den Wert, welcher auf dem Schnittpunkt liegt, mit den eingegebenen Kilogramm multiplizieren.


    Hoffe, dass ich mich halbwegs verständlich ausgedrückt habe...

    Weiss jemand Rat ??
     
  2. Hi seflere,

    Hab dir eine Makro geschrieben, der deine Wünsche erfüllen sollte.
    Der gesammte Makro muß in die Code-Seite der Tabelle kopiert werden.

    - Eingabe kg wird in F15 erwartet.
    - Eingabe km wird in F16 erwartet.
    - Ausge erfolgt in  F17.

    Wenn Du noch Hilfe beim Makro-Einfügen brauchst oder noch Änderungswünsche hast, melde dich oder mail mir.
    (mailadresse siehst Du, wenn Du angemeldet bist. )

    Gruß Matjes :)

    Code:
     ->Definition Zelle Eingabe kg
      Const c_Eing_kg_SP = 6   ->Spalte F
      Const c_Eing_kg_Z = 15   ->Zeile 15
     ->Definition Zelle Eingabe kg
      Const c_Eing_km_SP = 6   ->Spalte F
      Const c_Eing_km_Z = 16   ->Zeile 16
     ->Definition Zelle Ausgabe kg
      Const c_Ausg_Preis_SP = 6->Spalte F
      Const c_Ausg_Preis_Z = 17->Zeile 17
     ->Definition kg-Spalte : 451 -500kg
      Const c_kg_SP = 1         'Spalte A
      Const c_kg_Zanf = 2       'Zeile  2
      Const c_kg_Zend = 12     ->Zeile 12
     ->Definition km-Zeile : bis 100 km
      Const c_km_Z = 1         ->Zeile  1
      Const c_km_SPanf = 2     ->Spalte B
      Const c_km_SPend = 12     'Spalte L
    '***********************************************************
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
      Dim kg As String, l_kg As Long, km As String, l_km As Long
      Dim Zeile As Long, Spalte As Long, s_tmp As String
      
     ->eine Zelle geändert ?
      If Target.Count = 1 Then
        If (Target.Row = c_Eing_kg_Z And Target.Column = c_Eing_kg_SP) Or _
            (Target.Row = c_Eing_km_Z And Target.Column = c_Eing_km_SP) Then
         ->kg-Zelle oder km-Zelle geändert
          km = ActiveSheet.Cells(c_Eing_km_Z, c_Eing_km_SP).Value
          kg = ActiveSheet.Cells(c_Eing_kg_Z, c_Eing_kg_SP).Value
          If (km <> ) And (kg <> ) Then
            If IsNumeric(km) And IsNumeric(kg) Then
              l_km = km: l_kg = kg
              Call Kreuzwertsuchen(l_kg, l_km, Zeile, Spalte)
              If (Zeile > 0) And (Spalte > 0) Then
                ActiveSheet.Cells(c_Ausg_Preis_Z, c_Ausg_Preis_SP).Value = _
                             l_kg * ActiveSheet.Cells(Zeile, Spalte).Value
              Else
                MsgBox (Bei der Suche ist ein Fehler ausgetreten.)
              End If
            Else
              MsgBox (km- oder kg-Eingabe ist nicht numerisch)
            End If
          End If
        End If
      End If
      Exit Sub
    errorhandler:
      MsgBox (Es ist unerwartet Fehler  & Err.Number &  aufgetreten.)
      Err.Clear
      On Error GoTo 0
    End Sub
    '***********************************************************
    Function Kreuzwertsuchen(kg_Wert_Eing As Long, km_Wert_Eing As Long, _
                            Zeile As Long, Spalte As Long)
     ->sucht den kg-Wert und den km_wert und
     ->gibt Zeile/Spalte des Kreuzproduktes zurück
     ->Eingang:kg_Wert_Eing,km_Wert_Eing
     ->Ausgang:Zeile, Spalte des Kreuzproduktes
     ->Fehler :Zeile und/oder Spalte -1
    '***********************************************************
      Dim z As Long, kg_von As Long, kg_bis As Long
      Dim sp As Long, km_bis As Long
      
      Zeile = -1: Spalte = -1
      
     ->Zeile kg-Wert suchen
      For z = c_kg_Zanf To c_kg_Zend
        Call kgStringInWert(ActiveSheet.Cells(z, c_kg_SP).Value, kg_von, kg_bis)
        If (kg_von < 0) Or (kg_bis < 0) Then Exit Function->Fehler?
        If (kg_von <= kg_Wert_Eing) And (kg_Wert_Eing <= kg_bis) Then
         ->innerhalb des Intervals -> Wert gefunden
          Zeile = z
          Exit For
        Else
         ->Wenn bis zur letzten Zeile nicht gefunden -> letzte Zeile wählen
          If z = c_kg_Zend Then Zeile = z
        End If
      Next
      
     ->Spalte km-Wert suchen
      For sp = c_km_SPanf To c_km_SPend
        Call kmStringInWert(ActiveSheet.Cells(c_km_Z, sp).Value, km_bis)
        If (km_bis < 0) Then Exit Function ->Fehler?
        If km_bis >= km_Wert_Eing Then
          Spalte = sp
          Exit For
        Else
           'Wenn bis zur letzten Spaltee nicht gefunden -> letzte Spalte wählen
          If sp = c_km_SPend Then Spalte = sp
       End If
      Next
    End Function
    '***********************************************************
    Function kgStringInWert(kg_str As String, kg_von As Long, kg_bis As Long)
     ->Input : String der Form: 451 - 500 kg 
     ->Output: kg_von : 451
     ->        kg_bis : 500
     ->Fehler: kg_von :   0
    '***********************************************************
      Const c_kg_Trennzeichen = -
      Const c_kg_Einheit = kg
      Dim pos1 As Long, pos2 As Long, s_tmp1 As String, s_tmp2 As String
     ->Fehlerkennung vorbesetzen
      kg_von = -1: kg_bis = -1
      
     ->Trennzeichen Position feststellen
      pos1 = InStr(1, kg_str, c_kg_Trennzeichen)
      If pos1 > 0 Then
       ->k9 Position feststellen
        pos2 = InStr(1, kg_str, c_kg_Einheit)
        If pos2 > 0 Then
         ->Zahlen ausschneiden
          s_tmp1 = Left(kg_str, pos1 - 1)
          s_tmp2 = Mid(kg_str, _
                      pos1 + Len(c_kg_Trennzeichen), _
                      (pos2 - 1) - (pos1 - 1 + Len(c_kg_Trennzeichen)))
         ->alle Leerzeichen entfernen
          pos1 = InStr(1, s_tmp1,  )
          Do While pos1 > 0
            s_tmp1 = Left(s_tmp1, pos1 - 1) & Right(s_tmp1, Len(s_tmp1) - pos1)
            pos1 = InStr(1, s_tmp1,  )
          Loop
          pos1 = InStr(1, s_tmp2,  )
          Do While pos1 > 0
            s_tmp2 = Left(s_tmp2, pos1 - 1) & Right(s_tmp2, Len(s_tmp2) - pos1)
            pos1 = InStr(1, s_tmp2,  )
          Loop
          If IsNumeric(s_tmp1) Then kg_von = s_tmp1
          If IsNumeric(s_tmp2) Then kg_bis = s_tmp2
        End If
      End If
    End Function
    '***********************************************************
    Function kmStringInWert(km_str As String, km_wert As Long)
     ->Input : String der Form: bis 100 km
     ->Output: km_wert : 100
     ->Fehler: km_wert :  -1
    '***********************************************************
      Const c_km_Trennzeichen As String = bis
      Const c_km_Einheit As String = km
      Dim pos1 As Long, pos2 As Long, s_tmp As String
      
     ->Fehlerkennung vorbesetzen
      km_wert = -1
      
     ->bis Position feststellen
      pos1 = InStr(1, km_str, c_km_Trennzeichen)
      If pos1 > 0 Then
       ->km Position feststellen
        pos2 = InStr(1, km_str, c_km_Einheit)
        If pos2 > 0 Then
         ->Zahl ausschneiden
          s_tmp = Mid(km_str, _
                      pos1 + Len(c_km_Trennzeichen), _
                      (pos2 - 1) - (pos1 - 1 + Len(c_km_Trennzeichen)))
         ->alle Leerzeichen entfernen
          pos1 = InStr(1, s_tmp,  )
          Do While pos1 > 0
            s_tmp = Left(s_tmp, pos1 - 1) & Right(s_tmp, Len(s_tmp) - pos1)
            pos1 = InStr(1, s_tmp,  )
          Loop
          If IsNumeric(s_tmp) Then km_wert = s_tmp
        End If
      End If
    End Function
     
  3. Hi,

    habe das Makro mal eingefügt, bekomme allerdings dauerhaft eine Fehlermeldung. Werde die Tabelle mal entwerfen und Sie Dir mailen, damit Du die genaue Struktur noch einmal vor Augen hast.

    Danke schon einmal für Deine Hilfe !!!!!
     
Die Seite wird geladen...

Kreuzpreis ermitteln und multiplizieren - Ähnliche Themen

Forum Datum
Windows-Nutzungsdauer pro Benutzer ermitteln Software: Empfehlungen, Gesuche & Problemlösungen 31. Jan. 2014
Unterbrechnung des Ruhezustandes - Ursache ermitteln Windows 7 Forum 25. Jan. 2010
Laufzeit nach aufwachen aus dem Ruhezustand ermitteln. Windows XP Forum 27. Feb. 2012
Download-Quelle eines heruntergeladenen Bildes ermitteln! Software: Empfehlungen, Gesuche & Problemlösungen 22. Apr. 2011
IP Adresse einer Remoteverbindung ermitteln Windows XP Forum 9. März 2011