Hirdetés
- gban: Ingyen kellene, de tegnapra
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- CaNNa3IS: Kis előkarácsonyi muzsika csak nektek
- GoodSpeed: Ennél jobb Windows 7 Aero Skin nem igen van Windows 11-re (WindowBlinds 11)
- GoodSpeed: Márkaváltás sok-sok év után
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- bambano: Bambanő háza tája
- Ndruu: Segíts kereshetővé tenni a PH-s arcképeket!
- Brogyi: CTEK akkumulátor töltő és másolatai
-
LOGOUT
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
válasz
dtpeter
#5737
üzenetére
az tudom, hogy deklarálni így tudsz:
Dim stradat(2) As String
stradat(1) = "akarmi"
stradat(2) = "barmi"azt is tudom, hogy az első sorba a zárójelbe ha írsz értéket az lesz a tömb maximális mérete, ha üresen hagyod dinamikus lesz.
Csak azt nem tudom hogyan tudsz a tömb elemeire hivatkozni
De engem is érdekelne valaki megoldása.
-
válasz
Delila_1
#5727
üzenetére
őő akarom mondai hülye vagyok

szóval feladom.

megírom akkor 19 szer így...Sub receiving()
Sheets("IDE_MASOLD").Select
Dim sor, q, w, x, y, z, adat, ossz, fil
q = 0: w = 0: x = 0: y = 0: z = 0: ossz = 0
filteregy = Range("Data!C23").Text
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
adat = Cells(sor, 13)
If Cells(sor, 4) = filteregy And Cells(sor, 17) = "Warehouse Receiving - OOW" Then
If adat = " 1-10" Then q = q + 1
If adat = "11-20" Then w = w + 1
If adat = "21-30" Then x = x + 1
If adat = "31-60" Then y = y + 1
If adat = "61- " Then z = z + 1
End If
ossz = q + w + x + y + z
Next
Sheets("Data").Cells(2, 1) = ossz
Sheets("Data").Cells(5, 1) = q
Sheets("Data").Cells(8, 1) = w
Sheets("Data").Cells(11, 1) = x
Sheets("Data").Cells(14, 1) = y
Sheets("Data").Cells(17, 1) = z
End Sub
Sub visual()
Sheets("IDE_MASOLD").Select
Dim sor, q, w, x, y, z, adat, ossz, fil
q = 0: w = 0: x = 0: y = 0: z = 0: ossz = 0
filteregy = Range("Data!C23").Text
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
adat = Cells(sor, 13)
If Cells(sor, 4) = filteregy And Cells(sor, 17) = "Visual Inspection - OOW" Then
If adat = " 1-10" Then q = q + 1
If adat = "11-20" Then w = w + 1
If adat = "21-30" Then x = x + 1
If adat = "31-60" Then y = y + 1
If adat = "61- " Then z = z + 1
End If
ossz = q + w + x + y + z
Next
Sheets("Data").Cells(2, 2) = ossz
Sheets("Data").Cells(5, 2) = q
Sheets("Data").Cells(8, 2) = w
Sheets("Data").Cells(11, 2) = x
Sheets("Data").Cells(14, 2) = y
Sheets("Data").Cells(17, 2) = z
End Sub
Sub quicktest()
Sheets("IDE_MASOLD").Select
Dim sor, q, w, x, y, z, adat, ossz, fil
q = 0: w = 0: x = 0: y = 0: z = 0: ossz = 0
filteregy = Range("Data!C23").Text
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
adat = Cells(sor, 13)
If Cells(sor, 4) = filteregy And Cells(sor, 17) = "Quick Test - OOW" Then
If adat = " 1-10" Then q = q + 1
If adat = "11-20" Then w = w + 1
If adat = "21-30" Then x = x + 1
If adat = "31-60" Then y = y + 1
If adat = "61- " Then z = z + 1
End If
ossz = q + w + x + y + z
Next
Sheets("Data").Cells(2, 3) = ossz
Sheets("Data").Cells(5, 3) = q
Sheets("Data").Cells(8, 3) = w
Sheets("Data").Cells(11, 3) = x
Sheets("Data").Cells(14, 3) = y
Sheets("Data").Cells(17, 3) = z
End Sub -
válasz
Delila_1
#5723
üzenetére
ja, bocs, elgépeltem
megcsináltam ahogy mondod, de nem jóSub visual()
Sheets("IDE_MASOLD").Select
Dim sor, q, w, x, y, z, adat, ossz, fil
q = 0: w = 0: x = 0: y = 0: z = 0: ossz = 0
filteregy = Range("Data!C23").Text
For fil = 1 To 19
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
filterketto = Range("Data!AA & fil").Text
adat = Cells(sor, 13)
If Cells(sor, 4) = filteregy And Cells(sor, 17) = filterketto Then
If adat = " 1-10" Then q = q + 1
If adat = "11-20" Then w = w + 1
If adat = "21-30" Then x = x + 1
If adat = "31-60" Then y = y + 1
If adat = "61- " Then z = z + 1
End If
ossz = q + w + x + y + z
Next
Sheets("Data").Cells(2, 2 + fil) = ossz
Sheets("Data").Cells(5, 2 + fil) = q
Sheets("Data").Cells(8, 2 + fil) = w
Sheets("Data").Cells(11, 2 + fil) = x
Sheets("Data").Cells(14, 2 + fil) = y
Sheets("Data").Cells(17, 2 + fil) = z
End Suba hiba az hogy "For without Next"
hát ha jól értem akkor minden for ciklushoz kellene tartozni egy next-nek.
csak nem tudom hova kéne írni -
Macróba mi a joker karakter?
-
válasz
Delila_1
#5715
üzenetére
Szia!
alakul

szóval al ényeg, hogy az első (sor, 3) az a data!23-ból olvasom ki.
a második (sor, 13) az "adat"
a harmadik pedig 19 féle állapot.
én így akartam megoldani, de így nem jóSub visual()
Sheets("IDE_MASOLD").Select
Dim sor, q, w, x, y, z, adat, ossz, fil
q = 0: w = 0: x = 0: y = 0: z = 0: ossz = 0
For fil = 1 To 19
filteregy = Range("Data!C23").Text
filterketto = Range("Data!AA & fill").Text
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
adat = Cells(sor, 13)
If Cells(sor, 4) = filteregy And Cells(sor, 17) = filterketto Then
If adat = " 1-10" Then q = q + 1
If adat = "11-20" Then w = w + 1
If adat = "21-30" Then x = x + 1
If adat = "31-60" Then y = y + 1
If adat = "61- " Then z = z + 1
End If
ossz = q + w + x + y + z
Next
Sheets("Data").Cells(2, 2 + fil) = ossz
Sheets("Data").Cells(5, 2 + fil) = q
Sheets("Data").Cells(8, 2 + fil) = w
Sheets("Data").Cells(11, 2 + fil) = x
Sheets("Data").Cells(14, 2 + fil) = y
Sheets("Data").Cells(17, 2 + fil) = z
End SubÉrted így, hogy mit szeretnék?
tehát hogy az első érték az fix, vagyis az eleén eldől, hogy a vagy b.
a másik két értéken viszont minden lehetőségen végig kellene menni. -
válasz
Delila_1
#5709
üzenetére
nincs filter kettő.
részben arra gondoltam amit a (#5704) hsz-ben csináltál, csak azzal megspékelve, hogy a sor,17 értékét is szeretném 19 féle képpen módosítani.
tehát végigszámolni a már megadott módon, és utánna a sor, 17 értéke változikszerk:
vagy egyszerűbb lenne ha pl a data sheet AA1:AA19-ig lennének ezek az értékek, és így lehetne filter kettő? -
illetve a végét módosította, ahogy írtad...
Sheets("Data"). Cells(25, 2) = q
Sheets("Data").Cells(26, 2) = w
Sheets("Data").Cells(27, 2) = x
Sheets("Data").Cells(28, 2) = y
Sheets("Data").Cells(29, 2) = zÍgy gyorsabb...

Esetleg arra ötleted, hogy ne kelljen így külön megírni mindet, hanem ugorjon a következő étékre, és fusson le úgy is? Érted amit kérdezni szeretnék?

-
így gondolotam
Sub visua11()
Sheets("IDE_MASOLD").Select
filteregy = Range("Data!C23").Text
Dim sor, sor1, sor2, sor3, sor4, q, w, x, y, z
q = 0
w = 0
x = 0
y = 0
z = 0
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor, 4) = filteregy And Cells(sor, 13) = " 1-10" And _
Cells(sor, 17) = "Visual Inspection - OOW" Then q = q + 1
Next
For sor1 = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor1, 4) = filteregy And Cells(sor1, 13) = "11-20" And _
Cells(sor1, 17) = "Visual Inspection - OOW" Then w = w + 1
Next
For sor2 = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor2, 4) = filteregy And Cells(sor2, 13) = "21-30" And _
Cells(sor2, 17) = "Visual Inspection - OOW" Then x = x + 1
Next
For sor3 = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor3, 4) = filteregy And Cells(sor3, 13) = "31-60" And _
Cells(sor3, 17) = "Visual Inspection - OOW" Then y = y + 1
Next
For sor4 = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor4, 4) = filteregy And Cells(sor4, 13) = "61- " And _
Cells(sor4, 17) = "Visual Inspection - OOW" Then z = z + 1
Next
Sheets("Data").Select
Cells(25, 2) = q
Cells(26, 2) = w
Cells(27, 2) = x
Cells(28, 2) = y
Cells(29, 2) = z
End Sub -
válasz
Delila_1
#5699
üzenetére
Szia!
az Application.ScreenUpdating ismerem köszi
hát itt tartok, hátha így érthetőbb.
Sub visual()
Sheets("IDE_MASOLD").Select
filteregy = Range("Data!C23").Text
Dim sor, x
Dim sor1, y
x = 0
y = 0
For sor = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor, 4) = filteregy And Cells(sor, 13) = " 1-10" And _
Cells(sor, 17) = "Visual Inspection - OOW" Then x = x + 1
Next
For sor1 = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(sor1, 4) = filteregy And Cells(sor1, 13) = "21-30" And _
Cells(sor1, 17) = "Visual Inspection - OOW" Then y = y + 1
Next
Sheets("Data").Select
Cells(25, 2) = x
Cells(26, 2) = y
End SubSzóval a filteregy egy olyan érték, ami két féle lehet (most, majd a végén 5 lesz
) és egy cellából olvasom ki
a (sor,4) 5 + 1 különöböző állapotot vehet fel, és a (sor, 17) pedig 19 féle lehet
így jön ki a 114 -
válasz
Delila_1
#5685
üzenetére
Szia!
Köszönöm, állatsák, működik, és még azt is értem, hogy miért
Tényleg köszi 
már csak két kérdésem lenne... vagyis már csak egy, mert megoldottam közbe az egyiket mire leírtam

hogy tudom nem message box-ba írni az infót, hanem egy megadott cellába?

szerk:
ja, a 25-ször dolgot úgy értettem, hogy a három érték közül valamelyik mindig változik.
és így nem 25 hanem 114 variációm van.
-
Sziasztok!
a következőt szeretném megoldani egyszerűbben.
van egy adathalmazom. össze kell számolni a q oszlopban az x-eket akkor ha a d-ben talál y-t, és a és az m-ben o-t.
én az így oldottam meg most, hogy leszűröm a megfelelő adatokra az oszlopokat, a létrejött tartalmat átmásolom egy data2 sheet-re, a data sheet-en egy counta függvénnyel összeszámolom, és az értéket lemásolom.
így:Sheets("IDE_MASOLD").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="y"
Selection.AutoFilter Field:=13, Criteria1:="o"
Selection.AutoFilter Field:=17, Criteria1:="x"
Columns("Q:Q").Select
Selection.Copy
Sheets("data2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Data").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A20").Select
Sheets("data2").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.ClearContentsez jól működik, csak nagyon lassú. ezt 25-ször kell megcsinálni, így sokáig fut.
esetleg valami egyszerűbb megoldása valakinek?
Új hozzászólás Aktív témák
- Anglia - élmények, tapasztalatok
- PlayStation 5
- Milyen NAS-t vegyek?
- Okosóra és okoskiegészítő topik
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Xiaomi 14 - párátlanul jó lehetne
- Poco F8 Ultra – forrónaci
- One mobilszolgáltatások
- gban: Ingyen kellene, de tegnapra
- Elektromos autók - motorok
- További aktív témák...
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eladó Steam kulcsok kedvező áron!
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- 182 - Lenovo Legion 5 (15IRX10) - Intel Core i9-14900HX, RTX 5070
- HIBÁTLAN iPhone 13 Pro 256GB Sierra Blue 1ÉV GARANCIA -Kártyafüggetlen, MS3744, 100% Akkumulátor
- Honor Magic 7 Pro 512 Gb - AI Pro kamera, 6,8 120 Hz LTPO OLED, Snapdragon 8 Elite,3 hó gari!
- ÁRGARANCIA!Épített KomPhone Ryzen 5 9600X 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Apple iPhone 13 Mini 128GB,Újszerű,Dobozával,12 hónap garanciával
Állásajánlatok
Cég: BroadBit Hungary Kft.
Város: Budakeszi
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest



Fferi50
