MS Excel

Ahoj, priznam sa, ze sa mi nechce moc hladat, tak sa pytam: Nemate niekto po ruke code snippet, ktory by spojil data z dvoch poli (pole A a pole B) nasledovne:
A B Vysledok
a m am
b n bn
c o co
d p dp
Rad by som to urobil na urovni poli vo VBA a bez cyklu. Je to mozne, alebo sa bez cyklu, kde to budem spajat postupne po jednotlivych elementoch oboch poli (from lbound to ubound) neobidem?

Zaslat odpověď >

elninoslov(20.10.2017 21:25)#038098

Jediné, čo ma napadlo bez cyklu je
1. krok prasknúť polia do listu (riadok pre každé pole, prípadné transponovanie v tom istom kroku)
2. cez EVALUATE spojiť stĺpce (výsledok bude pole)

Sub pokus()
Dim A(), B(), Vysledok()
A = Array("a", "b", "c", "d")
B = Array("m", "n", "o", "p")
Cells(1, 1).Resize(UBound(A) + 1) = WorksheetFunction.Transpose(A)
Cells(1, 2).Resize(UBound(B) + 1) = WorksheetFunction.Transpose(B)
Vysledok = Evaluate("=A1:A" & UBound(A) + 1 & "&B1:B" & UBound(B) + 1)
Cells(1, 3).Resize(UBound(A) + 1) = Vysledok
End Sub
Môžeme ale diskutovať, či nebude rýchlejšie to prehnať cez cyklus čisto v rámci VBA.citovat

eLCHa(20.10.2017 21:43)#038099

Bude to rychlejší.
Neřeš to a udělej to cyklem.
Pokud teda nemáš milion záznamů. A i tak...citovat

AL(20.10.2017 21:47)#038100

Urobim to cyklom, obom Vam dakujem.citovat

elninoslov(21.10.2017 12:07)#038101

Tak dá sa použiť to EVALUATE aj bez listu:
Sub pokus()
Dim Vysledok()
Vysledok = Evaluate("=GetA()&GetB()")
End Sub
Function GetA()
GetA = Array("a", "b", "c", "d")
End Function
Function GetB()
GetB = Array("m", "n", "o", "p")
End Function
Ide to aj na horizontálne aj vertikálne pole, ale ak by bolo potreba Transpose (či už v EVALUATE alebo v GetA), tak bude obmedzenie na počet 34464 prvkov. Samozrejmosťou je predpoklad rovnakých rozmerov polí.

Cyklus je ale rýchlostne nenahraditeľný, asi 10x rýchlejší. Takto som to testoval:
Dim arrA(), arrB()

Function SpojEvaluate() As Double
Dim Vysledok(), sta As Double, sto As Double
sta = Timer
Vysledok = Evaluate("=GetA()&GetB()")
sto = Timer
SpojEvaluate = sto - sta
End Function

Function GetA()
GetA = arrA
End Function

Function GetB()
GetB = arrB
End Function

Function SpojCyklus() As Double
Dim i As Long, u As Long, Vysledok(), sta As Double, sto As Double
sta = Timer
u = UBound(arrA)
ReDim Vysledok(1 To u)
For i = 1 To u
Vysledok(i) = arrA(i) & arrB(i)
Next i
sto = Timer
SpojCyklus = sto - sta
End Function

Sub VyplnPolia(u As Long)
Dim i As Long
ReDim arrA(1 To u): ReDim arrB(1 To u)
For i = 1 To u
arrA(i) = "A" & i: arrB(i) = "B" & i
Next i
End Sub

Sub Check()
Call VyplnPolia(100000) 'Počet prvkov polí
MsgBox ("Evaluate : " & SpojEvaluate & vbNewLine & "Cyklus : " & SpojCyklus)
End Subcitovat

Téma: Data z dvoch poli do jedneho

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje