< návrat zpět

MS Excel


Téma: Doplňování dat MAKRO rss

Zaslal/a 12.1.2019 18:03

Merlin99Zdarvim vsechny resim jeden problem kde bych potreboval aktualizovat sloupcec s materialem ve na liste data. Logika by mela porovnat ktere materialy chybi oproti listu zdroj a tyto chybejici artikly pridat nakonec pod stavajici materialy na liste data. Kdyby nekdo dokazal budu rad . Příloha 9

Příloha: rar42419_pridat.rar (10kB, staženo 4x)
Zaslat odpověď >

#042424
elninoslov
Ale otestujte si to, príliš pozornosti som tomu nevenoval 7
Sub Aktualizuj()
Dim colData As New Collection, D As Long, R As Long, arrZdroj(), arrData(), Pocet As Long

With wsData
D = .Cells(Rows.Count, 5).End(xlUp).Row - 3
If D = 1 Then Exit Sub
ReDim arrData(1 To D, 1 To 1)
If D = 1 Then arrData(1, 1) = .Cells(4, 5).Value Else arrData = .Cells(4, 5).Resize(D).Value
End With

On Error Resume Next
For R = 1 To D
colData.Add arrData(R, 1), CStr(arrData(R, 1))
Next R
On Error GoTo 0

With wsZdroj
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 1 Then Exit Sub
ReDim arrZdroj(1 To R, 1 To 1)
If R = 1 Then arrZdroj(1, 1) = .Cells(2, 1).Value Else arrZdroj = .Cells(2, 1).Resize(R).Value
End With

Erase arrData

On Error Resume Next
For R = 1 To R
colData.Add arrZdroj(R, 1), CStr(arrZdroj(R, 1))
If Err.Number <> 0 Then
Err.Clear
Else
Pocet = Pocet + 1
ReDim Preserve arrData(1 To 1, 1 To Pocet)
arrData(1, Pocet) = arrZdroj(R, 1)
End If
Next R
On Error GoTo 0

If Pocet > 0 Then wsData.Cells(D + 4, 5).Resize(Pocet).Value = Application.Transpose(arrData)
End Sub
Příloha: zip42424_pridat-neexistujuce.zip (19kB, staženo 4x)
citovat
#042425
Stalker
Sice už elninoslov poskytl řešení, ale když už sem se s tím drbal (2x! 6, když sem to dokončil tak mi kleklo PC a soubor se neuložil), tak přidávám i to své.
Příloha: rar42425_pridat.rar (17kB, staženo 4x)
citovat
#042426
Merlin99
elninoslov: DÍKY za pomoc, to je presne ono co myslim jen s jednou chybou ze to neumi rozlisovat vice rozdilnych artiklu najednou (pak to blbne viz priloha přiklad). pokud byto slo jeste doladit byla by to pecka díííky 9
Příloha: rar42426_pridat-neexistujuce.rar (18kB, staženo 4x)
citovat
#042427
Merlin99
Stalker: Ouu to je presne ONO a funguje dokonale Ouuje 9 5 Díky moc za pomoc oboum.citovat
#042428
elninoslov
No veď vravím, že som to moc netestoval :) Zabudol som otočiť pole :( Vymenil som prílohu aj kód v prvom príspevku.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Funkce COUNTIFS

mepexg • 15.1. 10:59

Funkce COUNTIFS

elninoslov • 15.1. 6:42

Funkce COUNTIFS

Anonym • 14.1. 21:41

VBA import komentára

Stalker • 14.1. 18:31

Funkce COUNTIFS

elninoslov • 14.1. 15:33

Funkce COUNTIFS

mepexg • 14.1. 15:31

Excel 2013 když

Anonym • 14.1. 15:12