Szia!
Tulajdonképpen egy saját statisztikai adatbázist szeretnék csinálni (pl.: labdarúgás). A terv az, hogy egy munka lapon egy ország egy bajnoksága lenne, a bajnokság tabellájával és a bajnokságban lejátszott mérkőzésekkel. Tehát vegyünk mondjuk 10 országot országonként 10 bajnokságot az így 100 munkalap egy munkafüzetben.
Az adat bevitel egyszerű másolással történik weblapról.
Minden mást (szükség esetén formázást, számításokat, a tabella frissítését eredmények alapján, a lejátszott mérkőzések listájának bővítését) makrók végzik.
Nincs szükség diagrammokra és kimutatásokra sem igazából, mert amit szeretnék megjeleníteni statisztikai adatot azt egy userformra rá tudom tenni.
A cél az lenne, hogy ne kelljen a programnak újabb és újabb munkafüzeteket megnyitni( mondjuk, ha országonként más más munkafüzetben tárolnám az adatokat), mert ez a megoldás időnként hibához vezet a mentések során (korábbi tapasztalat, pl.: lefagyott..)
Az, hogy a munkafüzetben olyan formán tárolja az adatot ami nem támogatja a „simán rákattintok a cellára és átírom” módszert az nem baj , ha így kissebb helyet foglal de makróval ezt lehet szerkeszteni/szerkeszthető állapotba hozni…

Lehet rosszul emlékszem (arra a kevésre ami megmaradt :)) de az előző írásomba említett cikkben mintha az lett volna, hogy valami kis trükkel(mint fentebb írtam én a pivotra emlékszem de lehet rosszul) ,hogy az adatokat valamihez hozzárendelve halvány piros lesz a betű szín és nem szerkeszthető , és talán az excel egy saját formátumba menti le saját magába vagy munkafüzetbe… Ebben a cikkben viszont az is benne volt, hogy az így tárolt adatot vissza lehet hozni szerkeszthető formába.

Remélem mindent leírtam 🙂
Ha van ötlet szívesen fogadom, és köszönöm!

Szia!
Egy kis plussz…
Miután meghívtam a Teszt programot (call Teszt), nemcsak a munkalapon enged garázdálkodni, hanem az űrlapon elhelyezett commandbutton -hoz rendelt makrót is engedi lefutni. Szabad a gazda amíg az userform-ot be nem zárom.

Ez így több mint tökéletes!
Örök hála!!

Szia Imre!
Ha jól értettem akkor valami ilyesmire gondoltál. Erre az összefűzős megoldásra nem gondoltam, érdekes de jó. Nálam ez 6 mp alatt fut le 155791 soron.
Sub teszt2()
starttime = Time

a = Range(„D1”).Value & Range(„E1”).Value
b = Range(„E1”).Value & Range(„D1”).Value
c = 1
sor = 155791
Do
If Range(„A” & sor) & Range(„B” & sor) = a Or Range(„A” & sor) & Range(„B” & sor) = b Then
Range(„F” & c) = sor
c = c + 1
End If

sor = sor – 1
Loop Until c = 10 Or sor = 1
endtime = Time
fut = (endtime – starttime) * 24 * 60 * 60
Range(„A1”) = fut

End Sub

Én erre a megoldásra jutottam. Ez 1 mp alatt lemegy ugyanazon a listán.
Sub teszt3()
starttime = Time

vég = Cells(Rows.Count, „B”).End(xlUp).Row
x = Range(„D1”).Value
y = Range(„E1”).Value
sor = 1
With Range(„A1:B” & vég)
Set c = .Find(x, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress1 = c.Address
Set c = .FindPrevious(c)
Z = c.Row

End If
Set c = .Find(y, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress2 = c.Address
Set c = .FindPrevious(c)
v = c.Row

End If
End With

If Z > v Then
With Range(„A1:B” & vég)
Set c = .Find(x, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
End If
Do
Z = c.Row
o = c.Column

If o = 1 And Range(„B” & Z) = y Or o = 2 And Range(„A” & Z) = y Then
Z = c.Row
o = c.Column
Range(„G” & sor) = Z
sor = sor + 1
End If
Set c = .FindPrevious(c)

Loop Until sor = 10 Or Not c Is Nothing And c.Address = firstAddress
End With

Else
With Range(„A1:B” & vég)
Set c = .Find(y, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
End If
Do
Z = c.Row
o = c.Column

If o = 1 And Range(„B” & Z) = x Or o = 2 And Range(„A” & Z) = x Then
Z = c.Row
o = c.Column
Range(„G” & sor) = Z
sor = sor + 1
End If
Set c = .FindPrevious(c)

Loop Until sor = 10 Or Not c Is Nothing And c.Address = firstAddress
End With
End If

endtime = Time
fut = (endtime – starttime) * 24 * 60 * 60
Range(„B1”) = fut
End Sub

Köszönet a segítségért és ezért az oldalért, igazán hasznos.

Szia Titok!

Abban esetleg tudsz útmutatást adni hogy ezt a változáshoz rendelést hogyan tudom megoldani?

Köszönöm!!!!

Minden Tiszteletem a Tiéd és ne haragudj hogy ilyenekkel fárasztalak!

Legyen szép napod!!