Když nevím jak = makro? Podívejte se na Google a funkci COUNTIF.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Duplicitní hodnoty
MS Excel
Téma: Duplicitní hodnoty 
Zaslal/a mikar 13.12.2018 13:01
Ahoj všem,
řeším problém a nevím jak ho vyřešit. Ve sloupci A mám hodnoty - dejme tomu jména. Potřebuji pomoci makra najít duplicitní hodnoty a jedné z těch duplicitních hodnot přiřadit pebně dané slovo . Např. Duplicitní hodnoty v A1 Johan a v A4 taky Johan. K jedné z nich potřebuji připsat např. slovo "první" aby z toho vzniklo Johan první. Dá se to ? Díky všem za rady. :-)
(13.12.2018 14:06)#042090
V prílohe bez makra.
Příloha: 
42095_jmeno.xlsx (11kB, staženo 30x)
citovat42095_jmeno.xlsx (11kB, staženo 30x)Děkuji za odpověď, ale contif neřeší to, co jsem napsal. Vzorcem se to buhužel řešit nedá a proto hledám makro. Nepotřebuji dopsat duplicitní hodnotu do dalšího sloupce, ale u duplicitní hodnoty do té samé buňky dopsat slovo např. "první".
Ale i tak děkuji ...citovat
Ale i tak děkuji ...citovat
Takže, našel jsem na netu tento zajímavý kód, který jsem mírně upravil a dělá to, co právě potřebuji. Možno se to bude někdy někomu hodit :
Sub dopsatzaduplicitnihodnotu()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim x As Long
lastRow = Range("A65000").End(xlUp).Row
For x = 1 To lastRow
If Cells(x, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(x, 1), Range("A1:A" & lastRow), 0)
If x <> matchFoundIndex Then
Cells(x, 1) = Cells(x, 1) & " dopisovaná hodnota"
End If
End If
Next
End Sub
citovat
Sub dopsatzaduplicitnihodnotu()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim x As Long
lastRow = Range("A65000").End(xlUp).Row
For x = 1 To lastRow
If Cells(x, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(x, 1), Range("A1:A" & lastRow), 0)
If x <> matchFoundIndex Then
Cells(x, 1) = Cells(x, 1) & " dopisovaná hodnota"
End If
End If
Next
End Sub
citovat(14.12.2018 12:02)#042109
Drobná obměna úlohy (vhodná pro challenge, zde to není úplně efektivní řešení):
Sub OcislovatVyskyty()
Dim rngStart As Range
Dim rngKonec As Range
Dim rngData As Range
Dim arrData()
Dim i As Long
Dim lngPoradi As Long
Set rngStart = Cells(1)
Set rngKonec = Cells(Cells.Rows.Count, 1).End(xlUp)
Set rngData = Range(rngStart, rngKonec)
arrData = rngData
strAdresaA = "A1"
For i = 1 To UBound(arrData, 1) - LBound(arrData, 1) + 1
strAdresaB = Cells(i, 1).Address(False, False)
lngPoradi = Evaluate("=COUNTIF(" & strAdresaA & ":" & _
strAdresaB & "," & strAdresaB & ")")
arrData(i, 1) = arrData(i, 1) & " (" & lngPoradi & ")"
Next i
rngData = arrData
End Subcitovat
Sub OcislovatVyskyty()
Dim rngStart As Range
Dim rngKonec As Range
Dim rngData As Range
Dim arrData()
Dim i As Long
Dim lngPoradi As Long
Set rngStart = Cells(1)
Set rngKonec = Cells(Cells.Rows.Count, 1).End(xlUp)
Set rngData = Range(rngStart, rngKonec)
arrData = rngData
strAdresaA = "A1"
For i = 1 To UBound(arrData, 1) - LBound(arrData, 1) + 1
strAdresaB = Cells(i, 1).Address(False, False)
lngPoradi = Evaluate("=COUNTIF(" & strAdresaA & ":" & _
strAdresaB & "," & strAdresaB & ")")
arrData(i, 1) = arrData(i, 1) & " (" & lngPoradi & ")"
Next i
rngData = arrData
End Subcitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články