Új hozzászólás Aktív témák

• #48200 Fferi50 Topikgazda BEndre34 #48197

  Új Válasz 2022-01-06 12:12:18 #48200

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  válasz BEndre34 #48197 üzenetére

  Szívesen.

• #48199 Pakliman tag BEndre34 #48198

  Új Válasz 2022-01-06 12:07:21 #48199

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Pakliman

  tag

  válasz BEndre34 #48198 üzenetére

  Szívesen

  A tömbképletek már a felfogóképességem legvégsőbb határán vannak
  Ki tudom elemezni (némelyiket), de hogy én összerakjam...

  Fferi50:

• #48196 Pakliman tag BEndre34 #48192

  Új Válasz 2022-01-06 11:28:56 #48196

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Pakliman

  tag

  válasz BEndre34 #48192 üzenetére

  Szia!

  Módosítás:
  

  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(IsEmpty(c), Chr(1), c.Value)
Next c

Do While InStr(1, s, "11") > 0
s = Replace(s, "11", "1")
Loop

xDB = Len(s) - Len(Replace(s, "1", ""))
End Function

• #48195 Fferi50 Topikgazda BEndre34 #48194

  Új Válasz 2022-01-06 08:55:09 #48195

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  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.

• #48191 lappy őstag BEndre34 #48188

  Új Válasz 2022-01-05 21:51:45 #48191

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  lappy

  őstag

  válasz BEndre34 #48188 üzenetére

  Darabhatöbb függvény talán jó lehet vizsgálni kell hogy a cellák ne legyenek azonosak

• #48190 Pakliman tag BEndre34 #48188

  Új Válasz 2022-01-05 21:46:34 #48190

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Pakliman

  tag

  válasz BEndre34 #48188 üzenetére

  Szia!

  Egy lehetőség:
  

  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 Function

  Csak 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...

• #48075 Fferi50 Topikgazda BEndre34 #48073

  Új Válasz 2021-12-20 17:42:24 #48075

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  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.

• #48074 Delila_1 veterán BEndre34 #48073

  Új Válasz 2021-12-20 17:37:07 #48074

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  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.

• #47589 Pakliman tag BEndre34 #47586

  Új Válasz 2021-10-18 13:41:36 #47589

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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

• #47563 Pakliman tag BEndre34 #47562

  Új Válasz 2021-10-16 22:33:13 #47563

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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

Új hozzászólás Aktív témák