-
Fototrend
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
-
eszgé100
őstag
válasz
Fferi50
#47925
üzenetére
A fájl szűrés nélküli állapotban nyílik meg, és a manual update értéke ''no".
Ha kézzel átállítom "yes"-re függetlenül attól, hogy szűrtem-e, akkor alábbi kóddal tudtam megoldani, de nem vagyok benne biztos, hogy jól csináltam.Set scrange = ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
cntifres = WorksheetFunction.CountIfs(ws.Range("D2 : D" & lastrow), scrange, ws.Range("P2 : P" & lastrow), "yes")
If cntifres = 0 Then
If scrange.Row <= counter Then
Excel.Workbooks(fileName).Close SaveChanges:=True
ElseIf manualcheck = False & CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
End If
End IfAlapból a fájlokat nem látható ablakban nyitom meg, ezért még kellett a makró végére ez is, hogy megjelenjenek:
If manualcheck = True Then
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
If Not ws.Range("A" & counter).EntireRow.Hidden Then
sPath = ws.Range("D" & counter)
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
manual = ws.Range("P" & counter)
If CStr(manual) = "yes" Then Windows(fileName).Visible = True
End If
counter = counter + 1
Loop
ma.Activate
Range("A1").Select
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End IfRánézésre jól csináltam mindent?
Új hozzászólás Aktív témák
- A fociról könnyedén, egy baráti társaságban
- Racoon City árnyékában: Teszteltük a Resident Evil Requiemet
- Budapest és környéke adok-veszek-beszélgetek
- Garancia kérdés, fogyasztóvédelem
- Filmvilág
- Gyúrósok ide!
- Mini-ITX
- WoW avagy World of Warcraft -=MMORPG=-
- Óra topik
- NOTEBOOK / NETBOOK / Mac beárazás
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Mini Pc HP ProDesk 600 G2 / G4 / G5 // 6-9. gen // i3 / i5
- Lenovo ThinkPad T14s Gen 2 i5-1135G7 16GB 1000GB FHD 1 év garancia
- 263 - Lenovo ThinkBook 16p (G6 IAX) - Intel Core U9 275HX, RTX 5060
- 0perces DDR5 5600 vadiúj 2x16GB memória 1 év garancia
- RAZER Kunai Chroma 140mm 3 darabos szett RGB Ventilátor.
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
