Ahoj. Mistři, nešlo by tento zápis upravit? Pokud mám velké množství záznamů , tak je to pomalé. Dík
Public Sub jedinecneHodnoty()
Worksheets("RK").Range("K:K").ClearContents
Dim hodnoty As Variant
hodnoty = Worksheets("Datovepole").Range("C4:C200003").value
Dim jedinecne As New Collection
Dim hodnota As Variant, jedinecna As Variant
Dim obsahuje As Boolean
For Each hodnota In hodnoty
obsahuje = False
For Each jedinecna In jedinecne
If hodnota = jedinecna Then obsahuje = True
Next jedinecna
If obsahuje = False Then jedinecne.Add hodnota
Next hodnota
Dim i As Long
For i = 1 To jedinecne.Count
Worksheets("RK").Range("K" & i).value = jedinecne(i)
Next i
End Sub
Rychlejší vyhledání a zápis?
- elninoslov
- Level 2.5
- Příspěvky: 373
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Rychlejší vyhledání a zápis?
Kód: Vybrat vše
Public Sub jedinecneHodnoty()
Dim colJedinecne As New Collection
Dim Hodnoty(), Jedinecne()
Dim i As Long
Worksheets("RK").Range("K:K").ClearContents
Hodnoty = Worksheets("Datovepole").Range("C4:C200003").Value
On Error Resume Next
For i = 1 To UBound(Hodnoty, 1)
If LenB(Hodnoty(i, 1)) > 0 Then colJedinecne.Add Hodnoty(i, 1), CStr(Hodnoty(i, 1))
Next i
On Error GoTo 0
If colJedinecne.Count > 0 Then
ReDim Jedinecne(1 To colJedinecne.Count, 1 To 1)
For i = 1 To colJedinecne.Count
Jedinecne(i, 1) = colJedinecne(i)
Next i
Worksheets("RK").Range("K1").Resize(colJedinecne.Count).Value = Jedinecne
End If
End Sub
EDIT:
Toto je ešte rýchlejšie
Kód: Vybrat vše
Public Sub jedinecneHodnoty2()
Dim colJedinecne As New Collection
Dim Hodnoty(), Jedinecne()
Dim i As Long, J As Long
Worksheets("RK").Range("K:K").ClearContents
Hodnoty = Worksheets("Datovepole").Range("C4:C200003").Value
ReDim Jedinecne(1 To UBound(Hodnoty, 1), 1 To 1)
On Error Resume Next
For i = 1 To UBound(Hodnoty, 1)
If LenB(Hodnoty(i, 1)) > 0 Then
colJedinecne.Add True, CStr(Hodnoty(i, 1))
If Err.Number = 0 Then J = J + 1: Jedinecne(J, 1) = Hodnoty(i, 1) Else Err.Clear
End If
Next i
On Error GoTo 0
If J > 0 Then Worksheets("RK").Range("K1").Resize(J).Value = Jedinecne
End Sub
Re: Rychlejší vyhledání a zápis?
Zkusil jsem tu druhou verzi.
Naprosto úžasné. Vše proběhlo v momentě.
Elnino Děkuji jsi frajer. Beru tě na fórech za optravdu největšího borce. Nechci nijak osočit ostatní, a všem se omlouvám, ale asi to tak bude.
Moc mi to pomohlo.
Naprosto úžasné. Vše proběhlo v momentě.
Elnino Děkuji jsi frajer. Beru tě na fórech za optravdu největšího borce. Nechci nijak osočit ostatní, a všem se omlouvám, ale asi to tak bude.
Moc mi to pomohlo.
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 32 hostů