To by som netvrdil. Ak bude bunka iba jedna, tak vo Vašom zápise, nebude premenná typu pole ! Záleží na tom, čo s tým chcete robiť ďalej. Ak nasleduje nejaké spracovanie tej premennej ako pole, tak ten Váš prípad musí zákonite hodiť chybu, lebo nemáte čo indexovať. Môj kód Vám urobí pole 1x1, s ktorým pracujete v následnom spracovaní rovnako ako s akýmkoľvek iným poľom napr. 100x10000. Skúste si to. Pozor na to.
Pr.:
Sub zapamatuj()
Dim X As Long, Y As Long
Set My_Undo = Selection
With My_Undo
X = .Rows.Count
Y = .Columns.Count
ReDim My_array(1 To X, 1 To Y)
If X = 1 And Y = 1 Then My_array(1, 1) = .Value2 Else My_array = .Value2
End With
End Sub
Ale to iba v prípade súmernej, spojenej oblasti. Ak je označená oblasť obsahujúca viac AREAS, treba si každú zvlášť v cykle EACH uložiť napr do COLLECTION.
Napr. vzorec na 1000 riadkov.
To nepôjde, musíte si urobiť zlučovaciu tabuľku...
Tak takto asi nejako ...
A na čo je Vám na toto makro ?
Nakoniec ma niečo ešte napadlo (nový kód v pôvodnom príspevku). Ak sú Ano/Ne počítané vzorcom, pôvodné makro by ho nahradilo hodnotou, toto nové nie.
Upravené v predošlom príspevku.
OT: Všimol som si vo vedľajšom vlákne ...
Text na stĺpce - Oddelené - Ďalej - Iné "_" - Ďalej - Označím prvý stĺpec (očernie) a vyberiem Text - Dokončiť
Problém nastane tam, kde nemáte oddeľovač "_" (riadok 18. a 19.)
EDIT: a to som si reloadol, či niekto neodpovedá
Asi tak ?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AnoNe(), Citac(), Riadkov As Long, i As Long
If Target.Address = "$B$1" Then
If Target.Value2 = 1 Then
Riadkov = Cells(Rows.Count, 3).End(xlUp).Row
AnoNe = Cells(1, 3).Resize(Riadkov).Value2
Citac = Cells(1, 4).Resize(Riadkov).Value2
For i = 1 To Riadkov
If UCase(AnoNe(i, 1)) = "ANO" Then
If IsNumeric(Citac(i, 1)) Then Citac(i, 1) = Citac(i, 1) + 1
End If
Next i
Application.EnableEvents = False
Cells(1, 4).Resize(Riadkov).Value2 = Citac
Target.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
Napísal som Vám, že ak má slúžiť to vkladanie filtrovaného mena do nejakej bunky len preto, aby sa tým vyvolala Worksheet_Change, v ktorej potom ten filter nastavíte, tak to robiť nemusíte, ale priamo tam nastavte ten filter. Ak to tak nechcete, budiš, potom ale musíte zmeniť testovanú adresu bunky z $Q$8 na $P$8, lebo to $Q$8 je menené vzorcom, a ten Worksheet_Change nevyvolá. Teda napr.:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$P$8" Then
If IsEmpty(Target) Then
Sheets("Výpožičky").AutoFilter.ShowAllData
Else
Sheets("Výpožičky").Columns("F:F").AutoFilter Field:=6, Criteria1:=Target.Offset(, 1)
End If
End If
End Sub
Dnes sa mi Váš kód už študovať nechce, ak to nieje ono, skúste popísať ako chcete aby to fungovalo...
Myslíte obyčajné tlačítko na liste ?
Sub Doplnit()
ActiveCell.Value = "Nejaký text"
End Sub
Bez problémov :
Sub Michal()
Hárok7.Range("A1").Value = "Michal"
End Sub
Sub Lýdia()
Hárok7.Range("A1").Value = "Lýdia"
End Sub
Sub Anna()
Hárok7.Range("A1").Value = "Anna"
End Sub
Ale keď má byť skrytý, a zároveň do neho chcete vpisovať filtrované meno, aby sa vyvolala akcia, tak to nemusí ten list vôbec existovať a použite takéto niečo :
Sub Michal()
Call Filtruj("Michal")
End Sub
Sub Lýdia()
Call Filtruj("Lýdia")
End Sub
Sub Anna()
Call Filtruj("Anna")
End Sub
Sub Vsetko()
Call Filtruj("")
End Sub
Sub Filtruj(S As String)
If S = "" Then
Sheets("Výpožičky").ShowAllData
Else
Sheets("Výpožičky").Columns("F:F").AutoFilter Field:=6, Criteria1:=S
End If
End Sub
Pavlus, on nepotrebuje ale zistiť v KT jedinečné záznamy (alebo počet jedinečných záznamov) z jedného stĺpca ničím nepodmienené. Ale podmienkou jedinečnosti je jeden jedinečný záznam z prvého stĺpca a v ďalšom stĺpci sa zisťuje počet jedinečných záznamov druhého stĺpca podmienených prvých stĺpcom. A to je niečo iné ako linky čo hneď hodí G na Lasákovic klučinu a pod.
Ten DataModel vyzerá sľubne, testol som to, len snáď si to do budúcna aj zapamätám.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.