MS Excel

Zdravím,

mám prosím takvý dotaz:

mám dvě dynamické pole (Day1 a Day2). V jednom poli je uloženo 6 jmen a v jednom 5 jmen. Potřebuji, abych mohl tyto dvě pole porovnat a aby výstup byl takový:

Program vypíše, jaké jméno je v Day1 ale není v Day2 a zároveň číslovkou napíše, o kolik takových jmen se jedná (v našem případě to je logicky 1).

Později bude tento sysém aplikovaný na mnohem více jmen. Takže potřebuji aby to bylo vyřešeno makrem.

Za rady moc díky :)

Zaslat odpověď >

Strana: 1 2 3 4 5 další »

Jeza.m(5.9.2017 17:04)#037528

Jen takový čistě VBA pokus ...
Public Sub pokus()
Dim D1() As String
Dim D2() As String
Dim JeVD1 As String
Dim Jmena() As String
Dim ind As Boolean

D1 = Split("Karel,Pepa,Lojza,Jan,Marek,Ota", ",")
D2 = Split("Pepa,Lojza,Jan,Marek", ",")

For Each jm1 In D1
ind = False
For Each jm2 In D2
If jm1 = jm2 Then
ind = True
Exit For
End If
Next
If ind = False Then
JeVD1 = JeVD1 & jm1 & ","
End If
Next

Jmena = Split(JeVD1, ",")
If UBound(Jmena) > 0 Then
MsgBox "Počet Jmen chybějících v D2 = " & UBound(Jmena) & vbNewLine & vbNewLine & Join(Jmena, vbNewLine)
End If

End Sub
M@citovat

elninoslov(5.9.2017 21:41)#037532

Ďalšie 3 možnosti makrom. To sa dá ale aj cez KT. Musíte si na reálnych dátach skúsiť čo bude lepšie. Inak pozor funkcia TRANSPOSE funguje len do cca 32K záznamov, inak je treba pole otočiť cyklom.

Příloha: zip

37532_vymenuj-zhodne-mena-v-poli.zip (22kB, staženo 42x)

citovat

David123(6.9.2017 7:23)#037533

ahoj Jeza.m , díky za reakci.

Jde o to, že pole Day1 a Day2 mám. Je to pole jmen, které není zadáno staticky jak to máš ty, ale vždy se naplní aktuálními jmény, ze zdrojového listu
Sub meeting()
'
Dim Day1() As String ' First day meeting
Dim Day2() As String ' Second day meeting
Dim i As Integer
Dim last_row As Integer

last_row = ThisWorkbook.Worksheets"Tabelle4").Cells(Rows.Count,1).End(xlUp).Row
last_row2 = ThisWorkbook.Worksheets("Tabelle4").Cells(Rows.Count, 4).End(xlUp).Row

For i = 2 To last_row

ReDim Preserve Day1(i)

Day1(i) = Cells(i, 1).Value
ThisWorkbook.Worksheets("Tabelle4").Range("A" & i + 25).Value = Day1(i) 'Print array on the cells

Next i

For i = 2 To last_row2

ReDim Preserve Day2(i)

Day2(i) = Cells(i, 4).Value
ThisWorkbook.Worksheets("Tabelle4").Range("B" & i + 25).Value = Day2(i) 'Print array on the cells

Next i

Mám tedy dvě pole s jmény. A nyní potřebuji udělat toto:

V poli Day1 je (nyní pouze demonstračně) 6 jmen a v poli Day2 je 5 jmen.

Potřebuji, aby mi makro po stisknutí tlačitka zapsalo do buňky toto:

v Day1 je oproti Day2 "Karel". Pripadne, ze by bylo v poli Day2 vice lidi jak v Day1, makro zapise ze v poli Day2 je navic "Karel". Pokud v Day1 budou napriklad 3 jmena ktere nejsou v Day2 (a zbytek bude stejny), makro zapise tyto 3 jmena ve tvaru: V Day2 nejsou "3 jmena".

Kodu od tebe moc nerozumim uprimne: jsem zacatecnik ve VBA. Pokud by sel okomentovat byl bych rad.

Zaroven ale po upraveni promennych a spusteni kodu hazel program nesmyslne vysledky... Treba napsal do MsgBoxu jedno jmeno 4x po sobe...

Dikycitovat

elninoslov(6.9.2017 8:34)#037534

1. Nič čo popisujete teraz, v zadaní nemáte. Tam ste mal niečo iné. Tak som to pochopil ja.
2. Takéto príklady sa nepopisujú slovami, ale príkladom vo forme súboru (XLSM súbor musí byť zabalený do ZIP), kde bude na konkrétne manuálne vytvorenom príklade ukázané čo máte, a čo má byť výsledok.
3. Aké statické polia ? Moje polia sú dynamické. Veď si pri každom spustení nájde rozsah každého poľa. Ešte si aj predošlý výsledok dynamicky vymaže.
4. Že Vám hádže zlé výsledky po "úpravách" - no veď práve. Najskôr si dajte záležať na prílohe, potom Vám snáď urobíme nejaké verzie postupov, ktoré si otestujete na reálnych dátach (reálnom množstve údajov), a zistíte, ktoré Vám pobeží najrýchlejšie, alebo bude inak vyhovovať. Či máme okomentovať všetky naše riešenia, a Vy zmeníte zadanie ?

Polepšite sa

Sem s tou prílohou, a keď bude čas...

EDIT: Čo má ten Váš uvedený kód robiť ?
-chýba End Sub - to nieje problém
-Worksheets"Tabelle4") - to funguje bez zátvorky asi ťažko
-deklarácia last_row je, last_row2 nie
-použil ste najpracnejšiu možnú formu kopírovania oblasti buniek z jedného listu do druhého - bunku po bunke
-a čo index poľa 0 a 1 ? Keď dáte Redim(2) dostanete trojmiestne pole (0,1,2)
-takže z listu Tabelle4 nakopíruje A->A , D->B, žiadne porovnávanie to nerobí.

Tá príloha s príkladom a rozšírený popis je ešte potrebnejší.citovat

David123(6.9.2017 9:32)#037537

Ahoj elninoslov.

Díky za reakci :).

předchozí příspěvek byl spíše reakcí na příspěvek na Jeza.m. Na tvůj jsem ještě nestihl reágovat. Přikládám vzorový příklad v zip. souboru. Po zmáčknutí tlačítka se provede již zaslaný kód, který pouze vezme jména ve sloupci A a ve sloupci D, uloží je do dvou polí (Day1 a Day2) a po stisknutí tlačítka Výpis se pole vypíšou. Ten výpis mám jen pro kontrolu, zda jsou vážně jména uložena v polích.

Výsledek v tomto případě bude takový:

V Day1 chybí - Karel Mordýř, Miloslav Volný. A zároven zapsat počet jmen číslovkou. Tedy v tomto případě 2

V Day2 chybí - Nikolas Bannew, Jan Novotný, Lukáš Bolek a počet 3.

s VBA se učím asi 4 dny. Dostal jsem v práci za úkol vyrobit pro mě hodně složité makro a popisovaný úkol je jednou dílčí části. Postupně se dílčí části učím. Takže pokud jsem zvolil obtížný postup, je to možné.

Je již zadání popsané lépe? Za předchozí nepřesnosti se omlouvám. Pokud by nebylo něco jasné, pokusím se objasnit.

Za pomoc moc díky :)

Příloha: zip

37537_priklad.zip (17kB, staženo 33x)

citovat

eLCHa(6.9.2017 10:33)#037541

Jedna z milionu cest.
Seznam hodnot ukládám do pole sValues.
Počet zjistíte pomocí Ubound(sValues)Sub test()
Dim rRange1 As Range
Set rRange1 = Range("A1").CurrentRegion
Set rRange1 = rRange1.Offset(1, 0).Resize(rRange1.Rows.Count - 1, 1)
Dim rRange2 As Range
Set rRange2 = Range("D1").CurrentRegion
Set rRange2 = rRange2.Offset(1, 0).Resize(rRange2.Rows.Count - 1, 1)

Dim sValues() As String
ReDim sValues(1 To 1)
sValues(1) = vbNullString

For Each rCell In rRange1.Cells
If Application.WorksheetFunction.CountIf(rRange2, rCell.Value2) = 0 Then
If Not Len(sValues(1)) = 0 Then
ReDim Preserve sValues(1 To UBound(sValues) + 1)
End If
sValues(UBound(sValues)) = rCell.Value2
End If
Next rCell
Set rCell = Nothing

Set rRange1 = Nothing
Set rRange2 = Nothing
End Subcitovat

David123(6.9.2017 10:57)#037543

ahoj eLCHa.

Díky za reakci :).

Kód jsem vyzkoušel. Počet rozdílů vím kde zjistím. Ale nevím, jak mám udělat, aby mi makro vypsalo všechna jména které jsou v rRange1 a nejsou v rRange2. Jak na to prosím?
A pokud by si měl čas/chuť... Mohl by jsi prosím jednotlivé řádky okomentovat? Jak jsem již psal, teprve se učím a tvůj kód už vypadá hodně pokročile. Potřebuju to ne jen spustit, ale případně i někdy někomu vysvětlit nebo editovat.

Každopádně díky moc :)citovat

elninoslov(6.9.2017 12:36)#037545

Upravil som len môj 1. variant z 3 a popísal. Chcete aj ostatné moje popisovať a prerábať ? Neviem či sa s tým mám piplať (čítajte srať)

Máte tu už 5 variantov, treba si 1 vybrať a mi Vám ho popíšeme doladíme.

EDIT:Výmena prílohy, našiel som chybičku:
V starej prílohe je
WorksheetFunction.Max(R1, R1)
má to byť samozrejme
WorksheetFunction.Max(R1, R2)
Takže tu je vymenená príloha

EDIT: Opravená aj chyba, keď bolo meno iba 1, a oprava názvu poľa.

Příloha: zip

37545_test_1.zip (22kB, staženo 46x)

citovat

David123(6.9.2017 12:41)#037546

Díky moc elninoslov.

Podívám se na to. Samozřejmě mi stačí jedna varianta. Není třeba ladit všech 5. Podívám se a napíšu

EDIT:

je to přesně to co jsem potřeboval :-).

Diky moc!!

Kod je docela hardcore, ale verim, ze to pochopim :D.

Ještě jednou díky ;)citovat

David123(6.9.2017 13:00)#037548

Narazil jsem pri testovani na nejaky bug.

Kdyz zadam do Day2 jenom jedno jmeno do bunky (2,4) tak to spadne. Konkretne na radku - Day2 = .Cells(2, 4).Resize(R2).Value2 'načítanie mien do poľa Day2citovat

Strana: 1 2 3 4 5 další »

Téma: Porovnání dvou polí - VBA

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje