- iPhone topik
- Drágábban indíthat az új iPhone SE
- Fotók, videók mobillal
- Kipróbáltuk a Xiaomi 14 Ultra fotós szettjét
- DIGI Mobil
- Magyarországon is kapható a Honor 200 Lite, ennyibe kerül
- Android alkalmazások - szoftver kibeszélő topik
- Céges verziót mutatott be a HMD a Pulse Plusból
- Felújított okostelefonokat kínál a Rejoy
- Xiaomi 14 - párátlanul jó lehetne
Hirdetés
-
Egyszerűsíti termékportfólióját a HP
ph A cég úgy láthatja, hogy a túl sok márkajelzés nem tesz jót az átláthatóságnak.
-
Retro Kocka Kuckó 2024
lo Megint eltelt egy esztendő, ezért mögyünk retrokockulni Vásárhelyre! Gyere velünk gyereknapon!
-
Újabb országba vihet akkumulátorgyárat Elon Musk
it Miközben Kínában adatközpontot építhet Elon Musk és a Tesla, addig Indonézia kapcsán akkumulátorgyár felépítését fontolgatják.
-
Mobilarena
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
-
Pakliman
tag
válasz BEndre34 #47562 üzenetére
Szia!
Egy egyszerűsített lehetőség (nincs hibakezelés):
Sub Makró1()
Dim MFName As String
MFName = Dir("x:\utvonal\Jelenléti ##.##.xlsx")
Do While MFName <> ""
Workbooks.Open Filename:="x:\utvonal\" & MFName
ActiveWorkbook.Sheets(1).Copy Before:=Workbooks("Összesítő").Sheets(1)
ActiveSheet.Name = Mid(ActiveWorkbook.Name, 11, 6)
Workbooks(MFName).Close SaveChanges:=False
MFName = Dir 'NINCS PARAMÉTER!!
Loop
End Sub -
Pakliman
tag
válasz BEndre34 #47586 üzenetére
Szia!
Megoldható úgy is: az útvonalat a
ThisWorkbook.Path
fogja megadni a makróm elején:MFName = Dir(ThisWorkbook.Path & "\Jelenléti ##.##.xlsx")
De egy másik lehetőség:
A kollégák választják ki a szükséges táblázatokat (hibakezelést itt sem csináltam!).
Az összesítő munkalapra teszel egy ActiveX CommandButton-t, aminek a kódja:Private Sub CommandButton1_Click()
Dim twb As Workbook: Set twb = ThisWorkbook
Dim fd As FileDialog
Dim i As Long
Dim MFName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*"
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
If .SelectedItems(i) Like "*\Jelenléti ##.##.xls*" Then
Workbooks.Open Filename:=.SelectedItems(i)
MFName = ActiveWorkbook.Name
ActiveWorkbook.Sheets(1).Copy Before:=twb.Sheets(1)
ActiveSheet.Name = Mid(MFName, 11, 6)
Workbooks(MFName).Close SaveChanges:=False
End If
Next i
End If
End With
End Sub[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz BEndre34 #48073 üzenetére
Másold át a tartományt a Munka2 lapra. Írd be a képleteket a C2 és C3 cellákba, az utóbbit másold végig. Ha kell, a C oszlopot irányítottan, értékként másold az A helyére.
Szerk.: a Munka2 lapon a képletek beírása előtt rendezd a tartományt az ID szerint.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Fferi50
őstag
válasz BEndre34 #48073 üzenetére
Szia!
Ha a mutatott képleted működik, akkor csak annyi a teendőd, hogy a SOR(1:1) helyett
OSZLOP()-1 kifejezést írsz és elhúzod jobbra a képletet.
Itt a teljes tömbképlet, az A oszlopban az ID, B oszlopban a hetek, nincs fejléc.:=HAHIBA(INDEX(Munka1!$B$1:$B$3376;KICSI(HA($A1=Munka1!$A$1:$A$3376;SOR(Munka1!$B$1:$B$3376)-SOR(Munka1!$B$1)+1);OSZLOP()-1));"")
Üdv.[ Szerkesztve ]
-
Pakliman
tag
válasz BEndre34 #48188 üzenetére
Szia!
Public Function xDB(r As Range) As Long
Dim c As Range
Dim s As String
For Each c In r.Cells
s = s & IIf(s = "", "", ";") & IIf(IsEmpty(c), Chr(1), c.Value)
Next c
s = Replace(s, "1;1", "")
xDB = Len(s) - Len(Replace(s, "1", ""))
End FunctionCsak azokat az 1-eseket számolja, amelyik mellett nincs 1-es
(hiba: 3 egymás mellettit viszont már 1-nek számol!!).Ha jól értelmeztem a feladatot...
-
Fferi50
őstag
válasz BEndre34 #48194 üzenetére
Szia!
Próbáld meg a következő tömbképletet az A2 cellába:=SZUM(($B2:$R2=1)*($C2:$S2=""))
A képlet záró oszlopát módosítsd a számodra megfelelő módon (pl. $BH2 és $BI2), fontos, hogy a második rész egy oszloppal legyen eltolva az elsőhöz képest.
A tömbképletet Shift + Ctrl + Enter kombóval kell lezárni, az Excel kapcsos zárójelbe teszi.
Ez a képlet húzható lefelé.
Üdv. -
Pakliman
tag
Új hozzászólás Aktív témák
- Androidos tablet topic
- Borotva, szakállnyíró, szakállvágó topic
- Amlogic S905, S912 processzoros készülékek
- Radeon RX 6700 XT: a Big Navi közepe?
- Steam Deck
- Időjárás topik
- Autós topik látogatók beszélgetős, offolós topikja
- Milyen TV-t vegyek?
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Wise (ex-TransferWise)
- További aktív témák...
- Eladó Steam kulcsok kedvező áron!
- Warhammer Online - Age of Reckoning (DE) Collectors Box (Figurával!)
- AKCIÓ! - STEAM kulcsok / Punch Club, Oddworld: Soulstorm, Children of Morta, stb. - 2024.05.16.
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!
- Megmaradt - Eredeti Humble, Choice - Steam kulcsok
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs