Dobry den potreboval bych poradit mam sesit v excelu a na kazdem listu jednotlive PC a seznam SW a u nej v druhem sloupci licenci a potreboval bych pak na list Licence provest vypsani vsech SW jenz maji v licenci "nutna licence" a jeli to same na vice kartach pak siclo kolikrat se vyskytuji v sesitu je to mozne nejak provest pomoci macra????
Preden moc dekuji za jakoukoliv pomoc.
Excel count stejnych polozek Vyřešeno
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel count stejnych polozek
Nize je procedura VBA, vloz v editoru VBA do modulu:
Kód: Vybrat vše
Option Explicit
Sub SWNutnaLicence()
Dim Sht As Worksheet, SBlok As Range, SCll As Range
Dim TSht As Worksheet, TBlok As Range, TCll As Range, TNew As Range, i As Long
i = 0
Set TSht = Worksheets("licence")
Set TBlok = TSht.UsedRange
TBlok.Offset(1, 0).ClearContents
Set TNew = TSht.Range("a2")
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Licence" Then
Set SBlok = Range(Sht.Range("A24"), Sht.Range("A24").End(xlDown))
For Each SCll In SBlok
If SCll.Offset(0, 3).Value = "Nutna licence" Then
Set TBlok = Range(TSht.Range("A2"), TSht.Range("A2").End(xlDown))
With TBlok
Set TCll = .Find(SCll.Value, LookIn:=xlValues)
If Not TCll Is Nothing Then
TCll.Offset(0, 1).Value = TCll.Offset(0, 1).Value + 1
Else
TNew.Offset(i, 0).Value = SCll.Value
TNew.Offset(i, 1).Value = 1
i = i + 1
End If
End With
End If
Next SCll
End If
Next Sht
End Sub
Re: Excel count stejnych polozek
Velke diky presne tohle sme potreboval
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Excel count stejnych polozek
navstevnik: Moc hezká práce
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel count stejnych polozek
Nektere nazvy SW zacinaji mezerou, coz bylo osetreno nepouzitim parametru LokkAt v metode Find, ale nektere jsou shodne s casti delsiho nazvu, cehoz jsem si nevsiml, takze tyto jsou nespravne prirazeny. Nize je opravena verze odstranujici mezery na zacatku (konci), vyhledavajici cele nazvy a doplnena o setrideni soupisu:
Kód: Vybrat vše
Option Explicit
Sub SWNutnaLicence()
Dim Sht As Worksheet, SBlok As Range, SCll As Range
Dim TSht As Worksheet, TBlok As Range, TCll As Range, TNew As Range, i As Long
i = 0
Set TSht = Worksheets("licence")
Set TBlok = TSht.UsedRange
TBlok.Offset(1, 0).ClearContents
Set TNew = TSht.Range("a2")
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Licence" Then
Set SBlok = Range(Sht.Range("A24"), Sht.Range("A24").End(xlDown))
For Each SCll In SBlok
If SCll.Offset(0, 3).Value = "Nutna licence" Then
Set TBlok = Range(TSht.Range("A2"), TSht.Range("A2").End(xlDown))
With TBlok
Set TCll = .Find(Trim(SCll.Value), LookIn:=xlValues, LookAt:=xlWhole)
If Not TCll Is Nothing Then
TCll.Offset(0, 1).Value = TCll.Offset(0, 1).Value + 1
Else
TNew.Offset(i, 0).Value = Trim(SCll.Value)
TNew.Offset(i, 1).Value = 1
i = i + 1
End If
End With
End If
Next SCll
End If
Next Sht
Set TBlok = Range(TSht.Range("A2"), TSht.Range("B2").End(xlDown))
TBlok.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 16
- 6473
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
-
Excel komparacedvou soborů Příloha(y)
od teichmann.ondrej » 15 dub 2024 17:26 » v Kancelářské balíky - 11
- 3415
-
od teichmann.ondrej
Zobrazit poslední příspěvek
22 dub 2024 15:45
-
-
- 1
- 506
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
-
- 3
- 2104
-
od Story-Long
Zobrazit poslední příspěvek
14 srp 2023 10:11
-
- 5
- 2642
-
od mmmartin
Zobrazit poslední příspěvek
13 črc 2023 18:44
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 35 hostů