Příspěvky uživatele
< návrat zpět
O koľko rôznych číselných hodnôt má ísť? Ak iba o pár, dá sa to pomocou Vlastného formátu + Podmienený formát. Pomocou PF sa zadá VF vždy s dvomi podmienkami. Zobrazovať to bude ako chcete, vzorce budú fungovať ale počítať budú aj s číslami mimo číselnú oblasť, ktorú to pozná. Teda ráta sa aj s tou 50 v A9, ktorú VF ani PF nepozná.
Nič iné ma nenapadlo 
@ dejv351: len doplním - dajte si pozor na medzery pred menami. Ak budete robiť nejaké dohľadávania či sumár, nebude Vám to sedieť ("Pavel" nie je " Pavel").
Tak som to určo nemyslel. Písané slovo má nevýhodu absencie intonácie, čo často mení zamýšľaný význam. Neva.
Napadlo nás inak presne to isté. Riešení je určo hafo.
Tvoj postup u mňa funguje.
OT : Inak mne Excel aj Win blbne tiež. A žiaľ často. Ale už sa tomu strojím v blízkej dobe zakrútiť krkom, keď sa mi zdravotne polepší. Ako si písal minule k Vianociam, aby sme boli negatívni, tak som ti aj chcel napísať, že som negatívny testom, ale zároveň aj negatívne naladený. Posunuté 2 platničky na krku, 2 na krížoch, pre covid odložená operácia potrhaného menisku v ľavom kolene, na pravej nohe som si zlomil palec, nemôžem poriadne chodiť, sedieť ani ležať, hroziace vyberanie krčných mandlí, zlomil sa mi zub, covid ma obstreľuje už z každej strany (som imuno pacient), a choďte terazky po doktoroch ... Tak ak napíšem dakomu nejakú čovinu, len pls mávnite rukou, nemyslím to zle, som iba negatívny alias nasraný 
@Stalker: Nerozumiem presne, prečo tam máte oblasť INDEX($C$3:$K$1342...
Stačí
=IFERROR(INDEX(C3:K3;;MAX(IF(C3:K3<>0;COLUMN(C3:K3)))-2);"")
=IFERROR(INDEX(C3:K3;;MAX(KDYŽ(C3:K3<>0;SLOUPEC(C3:K3)))-2);"")
prípadne obyčajný nematicový vzorec
=IFERROR(LOOKUP(2;1/(C3:K3<>"");C3:K3);"")
=IFERROR(VYHLEDAT(2;1/(C3:K3<>"");C3:K3);"")
alebo rovnako nematicový
=IFNA(INDEX(C3:K3;MATCH(0;C3:K3;-1));"")
=IFNA(INDEX(C3:K3;POZVYHLEDAT(0;C3:K3;-1));"")
Skúste maticový vzorec
=SUM((IFERROR(SEARCH("; "&A2&";";"; "&Karty!$C$2:$C$100&";");0)>0)*1)
=SUMA((IFERROR(HLEDAT("; "&A2&";";"; "&Karty!$C$2:$C$100&";");0)>0)*1)
Toto máte určite zle technicky:
Sheets("Nabídka").Range(("B" & Radek), Range("B:BG" & Radek)).Copy
má to byť
Sheets("Nabídka").Range("B" & Radek & ":BG" & Radek)
a navyše ak nemajú listy rovnaké údaje na rovnakých riadkoch, tak je to zle aj logicky. Musel by ste použiť 2. cyklus. Keď jeden by bral vždy po jednom DATA a druhý cyklus by pre každý DATA riadok prešiel celú NABIDKA. To je zbytočne pomalé, preto som použil hromadný maticový MATCH/POZVYHLEDAT v Evaluate ("vyhodnocovač vzorcov").
Bola by dobrá príloha, kde by bolo vidieť, či sa jedná o rovnaké riadky, rovnaký počet riadkov, a či je vôbec potrebné kopírovať xlPasteAll, alebo by stačilo iba hodnoty. Ale je pravda, že to by som Vám zase iba skomplikoval kód :)
Oprava, zabudol som na korekciu v prípade, ak bude kontrolovaný iba 1 riadok, vtedy nevráti Evaluate pole ale iba hodnotu - opravené:
Sub Najdi_kopiruj()
Dim RadkuN As Long, RadkuD As Long, i As Long, aFind
Application.ScreenUpdating = False
RadkuD = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
If RadkuD = 1 Then MsgBox "Žádné data.", vbExclamation: Exit Sub
With Worksheets("Nabídka")
RadkuN = .Cells(Rows.Count, 1).End(xlUp).Row
If RadkuN = 1 Then MsgBox "Žádné nabídky.", vbExclamation: Exit Sub
aFind = Evaluate("=IFNA(MATCH('Data'!N2:N" & RadkuD & ",'Nabídka'!A2:A" & RadkuN & ",0),0)")
If IsArray(aFind) Then
For i = 1 To RadkuD - 1
If aFind(i, 1) > 0 Then .Range("B1:BG1").Offset(aFind(i, 1), 0).Copy Worksheets("Data").Cells(i + 1, "BY")
Next i
Else
If aFind > 0 Then .Range("B2:BG2").Copy Worksheets("Data").Cells(1, "BY")
End If
End With
Application.ScreenUpdating = True
End Sub
Neviem, či Vás chápem ... skúste iný prístup:
Sub Najdi_kopiruj()
Dim RadkuN As Long, RadkuD As Long, i As Long, aFind
Application.ScreenUpdating = False
RadkuD = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
If RadkuD = 1 Then MsgBox "Žádné data.", vbExclamation: Exit Sub
With Worksheets("Nabídka")
RadkuN = .Cells(Rows.Count, 1).End(xlUp).Row
If RadkuN = 1 Then MsgBox "Žádné nabídky.", vbExclamation: Exit Sub
aFind = Evaluate("=IFNA(MATCH('Data'!N2:N" & RadkuD & ",'Nabídka'!A2:A" & RadkuN & ",0),0)")
For i = 1 To RadkuD - 1
If aFind(i, 1) > 0 Then
.Range("B1:BG1").Offset(aFind(i, 1), 0).Copy Worksheets("Data").Cells(i + 1, "BY")
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
A priložte prílohu.
OT:
@marjankaj: Presne toto dodržiavam Najskôr všetky možnosti vyskúšam, preštelujem, potom googlujem, potom kontakt známych, no a potom ... potom príde manželka a spraví to 
EDIT: Inak ma napadá, ak by mali stĺpce hlavičky, a niekde by mohli byť 2 bunky s parametrom pre Rozšírený filter, tak stačí:
Sub Rozsireny_Filter()
Worksheets("List1").Range("A1:B141").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Worksheets("List1").Range("D1:D2"), CopyToRange:=Worksheets("List2").Range("A1"), Unique:=False
End Sub
Ešte sa mi za tie roky nestalo že by vo VBA mal integer či long inú default ako 0, alebo boolean po deklarácii nemal False, či nedajbože Range nemala Nothing, alebo string nemal "".
Ešte nejaký ten zdroj...
Ak sú to susedné bunky, kopírujte ich naraz obe:
Sub kopiruj()
Dim i As Integer, j As Integer
'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
With Worksheets("List1").Cells(i, 2)
If .Value > 0 Then
j = j + 1
Worksheets("List2").Cells(j, 1).Resize(, 2) = .Offset(0, -1).Resize(, 2).Value
End If
End With
Next i
End Sub
A ešte rýchlejšie cez pole (ale tu sa jedná o máličko údajov, takže asi zbytočné...)
Sub kopiruj2()
Dim i As Integer, j As Integer, D(), V()
D = Worksheets("List1").Range("A1:B140").Value
'zkopíruje A1:A140 pokud > 0
For i = 1 To 140
If D(i, 2) > 0 Then
j = j + 1
ReDim Preserve V(1 To 2, 1 To j)
V(1, j) = D(i, 1): V(2, j) = D(i, 2)
End If
Next i
If j > 0 Then Worksheets("List2").Range("A1").Resize(j, 2).Value = Application.Transpose(V)
End Sub
Pr.
Pr.
Dim Seznam1()
Private Sub ComboBox1_Change()
Dim r As Long, s As Integer
s = Application.Match(ComboBox1.Value, Seznam1, 0)
r = wsSeznam.Cells(Rows.Count, s).End(xlUp).Row - 1
ComboBox2.List = wsSeznam.Cells(2, s).Resize(r).Value
ComboBox2.ListIndex = 0
End Sub
Private Sub UserForm_Initialize()
Seznam1 = Application.Transpose(wsSeznam.Range("A1:C1").Value)
ComboBox1.List = Seznam1
ComboBox1.ListIndex = 0
End Sub
??? Takže v liste "Dovolené" budú vpisovať zamestnanci dátumy do buniek C4:W16 ? Je to prichystané pre 16 zamestnancov. Ale ročný prehľad, list "2021" je iba pre 6 ľudí.
Ja by som tam prirobil ešte kontrolu na existenciu checkboxu pre každú z buniek. Bude to používať človek, tvor omylný, a ľahko môže označiť aj oblasť (trebárs skrytú), kde už checkboxy sú...
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články