A co to řešit přes podmíněné formátování? To by podle mě bylo nejjednodušší. Výsledek pak může být stejný, jako máš na obrázku, tedy že ti duplicitní kód po zadání zčervená...
Podmíněné formátování dokonce přímo nabízí: "Formátovat pouze jedinečné nebo duplicitní hodnoty".
P.
Ahoj Pavlus,
ďakujem za tvoju odpoveď - áno samozrejme takto som to riešil zatiaľ doteraz - tu je ale nevýhoda že tých duplicít tam môžu byť desiatky až stovky a tak či tak to budem musieť potom ručne spracovať (spočítať hodnoty jednotlivých duplicít a zapísať) - ja som to jednoduchšie robil cez kontingenčnú tabuľku kde mi to už spočítalo samo.
Tu som mal skôr na mysli obísť tento sled krokov a spočítavať tie duplicity automaticky resp. po nejakej výzve že daný kód už bol oskenovaný a treba hodnotu počtu kusov pripočítať k už predtým zadanej hodnote (ideálne ak by ten daný kód v celom zozname už zadaných kódov vyhladalo a bunka by sa posunula práve tam). To už by som si iba pozrel akú hodnotu som zadal predtým, akú hodnotu chcem zadať teraz - spočítam a prepíšem predtým zadaný údaj.
Ak nie - ak sa to nepodarí nič sa nedeje - nie je to až taký problém ktorý by mi bránil v činnosti ale bolo by to fajn.
aj tak ďakujem za radu :)
skús takéto makro
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
On Error Resume Next
Range(Cells(1, 1), Cells(Target.Row - 1, 1)).Find(Target).Select
End If
End Sub
Řešení, které poslal Marjankaj, se mi velmi líbí. Jde o kompaktní a úplné řešení problému v podobě, jak ho tazatel definoval. Pro vlastní potřebu bych do něj doplnil ještě likvidaci zadané hodnoty na místě Target (pokud byla nalezena jinde) a zabezpečení toho, aby se vyhledaná původní hodnota posunula do viditelné oblasti na monitoru. V této podobě by si to mělo najít bohaté uplatnění.
Ja som to riešil trošku inak, žiaľ som to už včera nestihol.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, RNG As Range, TR As Long, TC As Integer, TV
With Target.Cells(1)
TV = .Value: TR = .Row: TC = .Column
If TC < 3 And TR > 2 And TV <> "" Then
Set RNG = Cells(3, TC).Resize(Cells(Rows.Count, TC).End(xlUp).Row - 2)
On Error Resume Next
R = WorksheetFunction.Match(TV, RNG, 0)
If R <> 0 And R + 2 <> TR Then
MsgBox ("Skok na 1. nájdený zhodný " & Choose(.Column, "kód", "ean") & " na riadku " & R + 2)
Cells(TR, 1).Resize(, 2).Value = Array("zadaj kód", "")
Application.Goto RNG(R)
End If
End If
End With
End Sub
Reaguje to aj na kód aj na ean, maže hodnotu, preskakuje na predošlú, chcel som ale ešte doriešiť situáciu ak nastane zmena vo viacerých bunkách naraz.
Inak to vypíše správu aj s riadkom kam pôjde, ale vidím ešte neduhy, napr. čo pri zmene vo vnútri tabuľky (nie na konci), treba doriešiť pokračovanie v hľadaní za aktuálne zmeneným riadkom, ak nieje posledný a ak nebol nález... Proste vždy hľadám možné problémy.
Elninoslov má pravdu v tom, že zdánlivě jednoduchá úloha má svá mnohá úskalí. Když jsem se pokusil rozvinout myšlenku, se kterou přišel Marjankaj o svoje rozšíření, vyšel mi z toho taky dost velký kód:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
On Error Resume Next
Range(Cells(1, 1), Cells(Target.Row - 1, 1)) _
.Find(What:=Target, LookAt:=xlWhole).Activate
If Err = 0 Then
Application.EnableEvents = False
If IsEmpty(Target.Offset(1, 0)) Then
Target.ClearContents
Else
Application.Undo
MsgBox "Změněná hodnota by byla duplicitní", _
vbExclamation, "ZMĚNA HODNOTY"
End If
Application.EnableEvents = True
End If
End Sub
No zadávateľ hlavne neuviedol ako sa budú tie kódy zadávať. Či ťukaním do klávesnice alebo nejako cez skener. Takto ťažko vychytávať muchy. A z jeho prílohy to veľmi jasné nie je.
28696_priklad.png
RSS nejnovější články