823 Aufrufe
Gefragt in Tabellenkalkulation von max19555 Einsteiger_in (91 Punkte)

Guten Morgen M.O.,

ich hoffe Du hast meinen Beitrag gefunden :)

Ich habe versucht Deine Codes in einem neuen Excel File zu mappen welches ich für die Berechnung von Kosten hernehmen aber ich kriege es nicht so wirklich zum Laufen. Ich habe die Datei im ähnlichen Format aufzubauen.

In dieser Datei gibt es aber einen Unterschied. Es sollten im ersten Schritt mehrere Spalten gleichzeitig ermittelt werden (Zonen: Spalte E bis K) - die Vorgängerdatei (Liste) hat ein Ausgabefeld (Spalte F) zurückgegeben. Das Modul dafür ist unter Zone gespeichert. Da wo ich Änderungen zu Deinem Originalcode vorgenommen habe, habe ich eine entsprechende Markierung geschrieben (ÄNDERUNG...).

Die hellblauen Felder (Spalte L bis Q) bedienen sich aus den Zonen davor: Express Plus (Spalte L) ist Spalte E, Spalte N ist Spalte F, Spalte P ist Spalte F. Dann erfolgt eine neue Auslesung im Datensheet (shpCost) anhand der Zonen, den Spaltennamen L, N, P, R (Gewicht), Inhalt (S). Jede Spalte hat ein eigenes Modul (CostZoneExpress, CostZoneExpressPlus, ...).

Ich kriege sogar für jede Spalte die Kosten raus aber die zweiten Spalten (Rate Type...) da schreibt er mir überall etwas rein obwohl bei den Preisen nix drin steht... also keine Übereinstimmung...

Ich habe sicherlich einiges falsch gemacht. Könntest Du bei Gelegenheit rein schauen?

http://supportnet.de/forum/?qa=blob&qa_blobid=3670514027080710149

LG Max

16 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Max,

hier mal ein Code zum ausprobieren:

Sub suche()

Dim varZone As Variant
Dim varSuche As Variant
Dim varShip As Variant
Dim lngLZeile As Long
Dim lngLSpalte As Long
Dim s As Long
Dim sc As Long
Dim z As Long
Dim i As Long
Dim u As Long

'Daten aus Tabellenblatt Eingabe in Feld einlesen
With Worksheets("Eingabe")
 lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row                  'Letzte Zeile in Spalte A
 lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column       'Letzte Spalte in Zeile 1
 varSuche = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte))    'Daten in Feld einlesen
End With

'Zonen in Feld einlesen
With Worksheets("Zonen")
 varZone = .UsedRange
End With

'ShipCost in Feld einlesen
With Worksheets("ShpCost")
 lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row                  'Letzte Zeile in Spalte A
 lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column       'Letzte Spalte in Zeile 1
 varShip = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte))    'Daten in Feld einlesen
End With

'Suchfeld durchlaufen
For s = 2 To UBound(varSuche, 1)
 'Zone durchsuchen
 For z = 2 To UBound(varZone, 1)
    If varSuche(s, 2) >= varZone(z, 2) And varSuche(s, 2) <= varZone(z, 3) Then
       If varSuche(s, 3) = varZone(z, 4) Then
           If varSuche(s, 4) >= varZone(z, 5) And varSuche(s, 4) <= varZone(z, 6) Then
             'gefundene Daten werden per Schleife in Suchfeld übertragen
             For i = 5 To 11
               varSuche(s, i) = varZone(z, i + 2)
             Next i
             End If
       End If
     End If
 Next z

 'ShpCost durchlaufen
 For sc = 2 To UBound(varShip, 1)
   For i = 12 To 16 Step 2
        If varSuche(1, i) = varShip(sc, 1) Then
               If varSuche(s, 19) = varShip(sc, 2) Then
                    If varSuche(s, 18) >= varShip(sc, 3) And varSuche(s, 18) <= varShip(sc, 4) Then
                        For u = LBound(varShip, 2) To UBound(varShip, 2)
                           If varSuche(s, i) = varShip(1, u) Then
                                varSuche(s, i + 7) = varShip(sc, u)
                                varSuche(s, i + 8) = varShip(sc, 5)
                                Exit For
                           End If
                        Next u
                    End If
               End If
         End If
    Next i
 
 
 Next sc

Next s

'Daten ausgeben
With Worksheets("Eingabe")
  For s = 2 To UBound(varSuche, 1)
    For i = 5 To 17
      .Cells(s, i) = varSuche(s, i)
    Next i
  Next s
End With

End Sub

Schau mal ob das so passt. Ich hoffe, ich habe dich richtig verstanden.

Gruß

M.O.

0 Punkte
Beantwortet von max19555 Einsteiger_in (91 Punkte)

Hallo M.O.

schön von Dir zu hören laugh

Ich habe es gerade getestet, die Spalten E bis K werden gefüllt :) aber die Spalten L bis Q bleiben leer und im Falle keines Matches wird bleibt es leer bzw. wird's übersprungen.

Es ist auch eine Monsterdatei :) Die Überschriften der Spalten stehen im Tabellenblatt ShpCost in Spalte A, die ermittelnden Zonen (Inhalt der Spalten E bis K) in den Spalten F bis AG (ShpCost), der Inhalt, Spalte S in Spalte B (ShpCost). Die Rate Types im Tabellenblatt Eingabe stehen in ShpCost immer in derselben Spalte E.

Ich bin im erklären recht wirr. Wenn das zu viel Arbeit ist, insbesondere weil ich kein wirkliches Talent im erklären habe, ist das ok. Ich möchte Dir ungern viel Arbeit damit machen.

LG

Max

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
ausgewählt von max19555
 
Beste Antwort

Hallo Max,

ja da war noch ein Fehler drin. Hier die verbesserte Version:

Sub suche()

Dim varZone As Variant
Dim varSuche As Variant
Dim varShip As Variant
Dim lngLZeile As Long
Dim lngLSpalte As Long
Dim s As Long
Dim sc As Long
Dim z As Long
Dim i As Long
Dim u As Long

'Daten aus Tabellenblatt Eingabe in Feld einlesen
With Worksheets("Eingabe")
 lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row                  'Letzte Zeile in Spalte A
 lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column       'Letzte Spalte in Zeile 1
 varSuche = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte))    'Daten in Feld einlesen
End With

'Zonen in Feld einlesen
With Worksheets("Zonen")
 varZone = .UsedRange
End With

'ShipCost in Feld einlesen
With Worksheets("ShpCost")
 lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row                  'Letzte Zeile in Spalte A
 lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column       'Letzte Spalte in Zeile 1
 varShip = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte))    'Daten in Feld einlesen
End With

'Suchfeld durchlaufen
For s = 2 To UBound(varSuche, 1)
 'Zone durchsuchen
 For z = 2 To UBound(varZone, 1)
    If varSuche(s, 2) >= varZone(z, 2) And varSuche(s, 2) <= varZone(z, 3) Then
       If varSuche(s, 3) = varZone(z, 4) Then
           If varSuche(s, 4) >= varZone(z, 5) And varSuche(s, 4) <= varZone(z, 6) Then
             'gefundene Daten werden per Schleife in Suchfeld übertragen
             For i = 5 To 11
               varSuche(s, i) = varZone(z, i + 2)
             Next i
             End If
       End If
     End If
 Next z

 'ShpCost durchlaufen
 For sc = 2 To UBound(varShip, 1)
   For i = 12 To 16 Step 2
        If varSuche(1, i) = varShip(sc, 1) Then
               If varSuche(s, 19) = varShip(sc, 2) Then
                    If varSuche(s, 18) >= varShip(sc, 3) And varSuche(s, 18) <= varShip(sc, 4) Then
                        For u = LBound(varShip, 2) To UBound(varShip, 2)
                           If varSuche(s, i - 7) = varShip(1, u) Then
                                varSuche(s, i) = varShip(sc, u)
                                varSuche(s, i + 1) = varShip(sc, 5)
                                Exit For
                           End If
                        Next u
                    End If
               End If
         End If
    Next i
 
 
 Next sc

Next s

'Daten ausgeben
With Worksheets("Eingabe")
  For s = 2 To UBound(varSuche, 1)
    For i = 5 To 17
      .Cells(s, i) = varSuche(s, i)
    Next i
  Next s
End With

End Sub


Schau mal, ob alle gewünschten Daten gefunden werden.

Gruß

M.O.

0 Punkte
Beantwortet von max19555 Einsteiger_in (91 Punkte)

Guten Morgen M.O,

es funktioniert wuuuuuuuuuuuuuuuunderbar laugh

Ich freu mich sooooooo rießig.

Denkst Du man kann den Part noch einbauen, bei denen wo nichts gefunden wurde oder ist das aufgrund der Datenmasse nicht wirklich möglich?

     .Cells(1 + z, 5) = "keine Übereinstimmung gefunden"

LG

Max

0 Punkte
Beantwortet von max19555 Einsteiger_in (91 Punkte)
Hallo M.O.,

ich habe bloss eine Verständnisfrage weil ich immer versuche den Code pro Zeile irgendwie zu verstehen :)

Wie hast Du das eingebaut das die Zonen E bis K aus Eingabe für die Suche im Tabellenblatt ShpCost F bis AG berücksichtigt werden?

VG

Max
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Max,

das ist wirklich die leichteste Übungwink:

Ersetze den Teil

'Daten ausgeben
With Worksheets("Eingabe")
  For s = 2 To UBound(varSuche, 1)
    For i = 5 To 17
      .Cells(s, i) = varSuche(s, i)
    Next i
  Next s
End With

duch

'Daten ausgeben
With Worksheets("Eingabe")
  For s = 2 To UBound(varSuche, 1)
    For i = 5 To 17
      If varSuche(s, i) <> "" Then
            .Cells(s, i) = varSuche(s, i)
          Else
            .Cells(s, i) = "Nichts gefunden"
      End If
    Next i
  Next s
End With

Gruß

M.O.

0 Punkte
Beantwortet von max19555 Einsteiger_in (91 Punkte)

für Dich bestimmt laugh

Ich übe mich an Deinem Code im Test-File.

ich habe bloss eine Verständnisfrage weil ich immer versuche den Code pro Zeile irgendwie zu verstehen :)

Wie hast Du das eingebaut das die Zonen E bis K aus Eingabe für die Suche im Tabellenblatt ShpCost F bis AG berücksichtigt werden?

Was bedeutet Ubound? Ich habe einige VBA Schnipsel aus dem Internet aber das mit dem Ubound habe ich noch nie gelesen.


VG

Max

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Max,

LBound = lower Bound = untere Grenze des Feldes
UBound = upper Bound = obere Grenze des Feldes
Nachlesen kannst du z.B. hier.
Dank deiner Rückfrage habe ich gerade festgestellt, dass im Code ein Fehler ist sad (Denkfehler!).  Ich muss ihn also noch einmal etwas überarbeiten.
Gruß
M.O.
0 Punkte
Beantwortet von max19555 Einsteiger_in (91 Punkte)
Hallo M.O,

Danke für den Link :)

Ich bin eben nicht gut im erklären :)

Danke fürs überarbeiten. und sorry wegen der vielen Arbeit.

LG

Azem
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Max,

eine Frage habe ich aber noch. Für Express Weekend gibt es in den Spalten E bis K ja keinen entsprechenden Eintrag. Wie wird denn hier die Spalte in ShpCost ausgewählt.

Und mach dir keinen Kopf wegen der Überarbeitung. Würde mir das keinen Spaß machen, dann würde ich es nicht machen.

Gruß

M.O.
...