přiřazení hodnoty na základě třech podmínek Vyřešeno

[navstevnik]

Upresni. V poslednim sesitu v priloze se polozka ID palety nevyskytuje (nebo to je polozka Palette; vzhledem k casovemu odstupu dnesniho pozadavku od posledni upravy si to nepamatuji).
Vyradit podminku ID palety znamena, ze je odstranen prislusny sloupec (tedy Palette) a tim samozrejme i zmena podminek setrideni nebo pouze setrideni podle dvou podminek "KANBAN" a "DAVKA"?

[Reklama]

[Danyy]

ano je to palette, jestli to pujde sloupeček by zůstal ale už by se sním nepočítalo. po vyskoušení v praxi by stačilo pouze dva sloupečky "KANBA" a "DAVKA"

díky

[navstevnik]

Nize je upravena procedura VBA, vloz do modulu1 misto puvodni, navic osetren stav s prazdnym listem

Kód: Vybrat vše

Option Explicit

Sub PorovnejData()
  Dim SBlk As Range, SCll As Range, SortBlk As Range
  Dim Polozka As String
  Application.ScreenUpdating = False
  ' definice bloku bunek ve sloupci A:A
  With Worksheets("list1")
    Set SBlk = .Range(.Range("a2"), .Range("a2").End(xlDown))
    If SBlk.Rows.Count >= .Rows.Count - 1 Then
    MsgBox "Na listu nejsou data": Set SBlk = Nothing: Application.ScreenUpdating = True: Exit Sub
    End If
  End With
  ' odstranit pripadne stare oznaceni v m:m
  SBlk.Offset(0, 10).Cells.ClearContents
  ' definice bloku pro setrideni Kanban-Davka
  Set SortBlk = SBlk.Resize(SBlk.Rows.Count + 1, 11).Offset(-1, 0)
  ' odstranit pripadny InteriorColor
  SortBlk.Interior.ColorIndex = xlNone
    With SortBlk
    .Sort Key1:=.Resize(1, 1).Offset(1, 0), Order1:=xlAscending, Key2:=.Resize(1, 1).Offset(1, 6) _
        , Order2:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
  ' oznacit zaznamy se shodnym Kanban, kde na pozici Vystupni prepraviste
  ' neni paleta v nejnissi setridene davce - toto poradi
  ' zajisteno predchozim setridenim
  Polozka = vbNullString
  For Each SCll In SBlk.Cells
    If SCll <> Polozka Then
      Polozka = SCll.Value
    Else
      If SCll.Offset(0, 9).Value = "Výstupní přepraviště" Then
      SCll.Offset(0, 10).Value = "***" ' ve sl k:k
      SCll.Resize(1, 10).Interior.ColorIndex = 6 ' InteriorColor
      End If
    End If
  Next SCll
  SortBlk.Columns.AutoFit
  Application.ScreenUpdating = True
  Set SCll = Nothing
  Set SBlk = Nothing
  Set SortBlk = Nothing
End Sub

[Danyy]

šlo by upravit aby si nevšímal palet na vystupním přepravišti když mají stejnou davku ale podle pallete čísla je na meziskladě.

[navstevnik]

Mam pozadavku rozumet tak, ze je potreba pro zmenu oznacit pro shodne Kanban-Davka paletu s nejnizsim cislem, pokud se nachazi v meziskladu namisto doposud pozadovaneho reseni "mladsi" paleta na Vystupnim prepravisti?
No a co zamyslis s listem Upozorneni? Zadej to hned, at se reseni nekouskuje.

[Danyy]

jen sem myslel že by se neoznačovalo pokud by na vystupním přepraviští i na meziskladu nacházeli stejné dávky, ale zatím my to stačí,
list upozornění používám když aktualizuju sešit a natáhne data z jiného programu, aby se ukázalo co se kde porušilo, stránka upozornění je pouze
pro vyzualizaci.

[navstevnik]

Dobre, tak se tim nebudu dale zabyvat, pokud nebudes pozdeji pozadovat podstanejsi zmeny.