Mno, ono záleží na tom, jak je postavený monitor. Pokud standardně, tak nejvýše je vždy hodnota v řádku 1.
Očekávám doplňující dotaz pro duplicitní hodnoty...
Stačí hledat, i tady je takových dotazů plno. Jediný rozdíl je, že to máte v řádku...
Pokud je to jednorázovka, tak trik s F9:
1. napište =
2. označte oblast
3. stiskněte F9
4. odmažte = a složení závorky, případně uvozovky (CTRL+H), pokud vadí
Pokud je toho hodně, tak ten texťák nezní špatně. Zase můžou být problém uvozovky, pokud chybí ;))
Mno a pokud to má být vzorec a nemáte excel 2016
CONCATENATE_RANGE
Nezdá, počítá. Přesně jak to máte v příloze. Tam jste použil WEEKNUM s argumentem 1, tedy začínat nedělí.
V mém druhém příspěvku máte vzorec upravený.
@Radek-Klepacek
Vaše týdny začínají nedělí, je to v pořádku?
To co píše Pavlus, tady u tohoto vzorce neplatí. =SUMIFS('20371+20372'!$S:$S;'20371+20372'!$F:$F;">="&DATUM(ROK($B$1);1;-2)-DENTÝDNE(DATUM(ROK($B$1);1;3))+C$3*7;'20371+20372'!$F:$F;"<="&DATUM(ROK($B$1);1;-2)-DENTÝDNE(DATUM(ROK($B$1);1;3))+C$3*7+6)
Heh - tak to bych nechtěl dělat ručně ;))
Makrem - pokud jsou soubory v jedné složce, tak i jednoduchým.
A když budete hledat, tak tady i najdete řešení, ze kterého budete moci vyjít.
Víc bez přílohy nelze říci
Mno - nedávno jsem to řešil. Také potřebuji porovnávat podobnost textů. U mne ale byla výhoda, že vím, že ty texty musí začínat stejně (po odstranění diakritiky) a hledám tedy délku shody na začátku textu. Např.:
Na zelené louce
Na zelené louce leží kravička
výsledek - 51,7%, 15 znaků
Na zelené louce leží kravička
Na zelené louce leží krabička
výsledek - 82,8%, 24 znaků
To jsou pro mé potřeby dostatečné výsledky.
Nicméně ten druhý případ ukazuje, že v jiných případech toto stačit nebude.
Ve svém hledání jsem narazil na
Fuzzy logiku
Hammingovu vzdálenost
Levenshteinovu vzdálenost demo
Pak mám tento odkaz
http://www.ms.mff.cuni.cz/~kopecky/vyuka/dis/
ale ještě jsem nenašel čas si to přečíst.
Zatím mi to připadá, že obecného nic neexistuje, protože pokaždé řešíš něco jiného (výskyt řetězce v řetězci nebo podobnost řetězců). Časově to bude logicky tak náročné, jako počet porovnávaných řetězců a jejich délka. Vlastní funkce na listu bych se asi bál. Myslím něco jako SVYHLEDAT - tedy hledání podobného výskytu v oblasti.
No ona je to dneska vlastně už věda bych řekl - vyhledávání plagiátů. Takže nějaké nástroje už existovat budou...
Vaše týdny začínají nedělí, je to v pořádku?=SUMIFS('20371+20372'!$S:$S;'20371+20372'!$F:$F;">="&DATUM(ROK($B$1);1;-2)-DENTÝDNE(DATUM(ROK($B$1);1;3))+C$3*7-1;'20371+20372'!$F:$F;"<="&DATUM(ROK($B$1);1;-2)-DENTÝDNE(DATUM(ROK($B$1);1;3))+C$3*7+5)
Mno přiznám se, že asi nerozumím a hlavně mám jiné výsledky, protože ve vašem příkladu asi počítáte se zaokrouhlenými poměry.
Pokud jsem to pochopil alespoň trochu správně, tak VBA nepotřebujete, chce to jen připravenou výstupní tabulku.
Ale myslím, že jsem to správně nepochopil.
@AL
Výsledek dostaneš, takže proti tomu nic nemám.
;))
Ono záleží, jaké má člověk prostředky a jestli je to jednorázovka. Pukud je, má to hromadu záznamů a mám Access, tak to udělám v něm a překopčim de excelu. Je to bez programování (vyjma tedy dotazu).
Pokud to je pár údajů a jednorázovka (viz moje příloha), tak žádný Access ani MSQuery:
Zkopíruji data o pár sloupců vedle, odeberu duplicity, seřadím a použiju MATCH. Tak 30s a mám hotovo.
Dotaz byl na VBA. Mno a protože je to zajímavá úloha (což dokazuje i skladba účastníků diskuse ;)) ), tak jsem to VBA udělal.
Taky jsem se mohl vykašlat na celé SQL a udělat to tak, jak píšu, že ;)) . Ale mne zajímalo to SQL a nelíbí se mi počet přístupů na list.
Sub subReplace()
Cells(1, 3).Resize(Cells(1, 1).CurrentRegion.Rows.Count, 1).Value = Cells(1, 1).CurrentRegion.Value
Cells(1, 3).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
Cells(1, 3).CurrentRegion.Sort Key1:=Cells(1, 3), Order1:=xlAscending, Header:=xlNo
With Cells(1, 1).CurrentRegion
.Offset(0, 1).Formula = "=MATCH(RC[-1]," & Cells(1, 3).CurrentRegion.Address(ReferenceStyle:=xlR1C1) & ",0)"
.Value = .Offset(0, 1).Value
End With 'Cells(1, 1).CurrentRegion
ThisWorkbook.Worksheets("Zdroj").UsedRange.EntireColumn.Offset(0, 1).Delete
End Sub
@AL
Ano - toto jsi napsal už dříve. Bohužel to vyžaduje zápis na list, pak výpočet a převod na hodnoty. Tedy několikrát používáš zápis na listu. Výsledek dostaneš, takže proti tomu nic nemám.
Já to chtěl všechno mimo a to umí SQL.
další možností je asi použití Dictionary místo Collection, který by snad měl umět řazení (nikdy jsem ho nepoužil, tak pokud plácám, tak mně opravte) - opět mimo zápis na list, ale několik cyklů.
Pokud se chceme vyhnout Evaluate do pole, tak mi nápad s SQL přišel zajímavý a vyzkoušel jsem ho.
Do Replace bych nešel. Tady se nabízí SQL. Bohužel MSQuery totoSELECT
t5.Poradi
FROM
test AS t4
LEFT JOIN
(
SELECT DISTINCT
t3.Hodnota,
(
SELECT
COUNT(t2.Hodnota) + 1
FROM
(
SELECT DISTINCT
t1.Hodnota
FROM
Test AS t1
) AS t2
WHERE
t2.Hodnota < t3.Hodnota
) AS Poradi
FROM
Test AS t3
) AS t5 ON
t4.Hodnota = t5.Hodnotazdá se nezvládá (provedl jsem 1 pokus) a tak jsem to udělal přes ADO.
Výstup jsem si šoupl do jiného listu, ať to vidím.
Nakonec jsem použil Transpose (pokud by bylo více než 65k řádků, muselo by se upravit)Sub subReplace()
Const csSHEET_SOURCE As String = "Zdroj"
Const csSHEET_OUT As String = "Vystup"
Dim adoConn As Object
Set adoConn = CreateObject("ADODB.Connection")
adoConn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Macro;HDR=NO"";"
With adoConn
.Mode = 1
On Error Resume Next
.Open
If Not Err.Number = 0 Then
Debug.Print "001 " & Err.Description
End If
On Error GoTo 0
If adoConn.State = 1 Then
Dim sSql As String
sSql = "SELECT t5.Poradi FROM [" & csSHEET_SOURCE & "$] AS t4 LEFT JOIN (SELECT DISTINCT t3.F1, (SELECT COUNT(t2.F1) + 1 FROM (SELECT DISTINCT t1.F1 FROM [" & csSHEET_SOURCE & "$] AS t1) AS t2 WHERE t2.F1 < t3.F1) AS Poradi FROM [" & csSHEET_SOURCE & "$] AS t3) AS t5 ON t4.F1 = t5.F1"
Dim adoRS As Object
Set adoRS = CreateObject("ADODB.Recordset")
On Error Resume Next
adoRS.Open sSql, adoConn, 3, 1, 1 ' adOpenStatic, adLockReadOnly, adCmdText
If Not Err.Number = 0 Then
Debug.Print "002 " & Err.Description
End If
On Error GoTo 0
If Not adoRS Is Nothing Then
If Not adoRS.ActiveConnection Is Nothing Then
If adoRS.State = 1 Then
If Not adoRS.BOF And Not adoRS.EOF Then
Dim vVals As Variant
vVals = adoRS.GetRows
ThisWorkbook.Sheets(csSHEET_OUT).Cells(1).Resize(UBound(vVals, 2) - LBound(vVals, 2) + 1, 1).Value = Application.Transpose(vVals)
End If
adoRS.Close
Set adoRS = Nothing
End If
End If
End If
.Close
End If
End With 'adoConn
Set adoConn = Nothing
End SubEdit:
Vidím tam potenciální chybu - oproti příloze jsem posunul zápis dat nahoru - v příloze to neměním
@xlnc
neohroženě. ;)
Zadání nerozumím, proto jsem se k němu nevyjadřoval.
Nicméně od té doby, co dělám s Access <-> Excel a číselníkovými daty mi .Value způsobilo už párkrát problémy. Tak jen upozorňuji. ;)
@xlnc
Ano, přímé přiřazení.
Tady se trošku zastanu Stalkera
.Value = .Valuenení úplně bezpečné, protože tento způsob převádí hodnoty.
Např.:
Text 1.2 => Číslo 1,2
Text 123 => Číslo 123
Text 1/2 => Datum 2.1
Tohoto faktu využívám (nejčastěji VBA převod text -> číslo)
Ale při kopírování hodnot se raději vracím keRange1.Copy
Range2.PasteSpecial(xlValues)
@kristv
I na tomto fóru najdete řešení, jediný rozdíl je v tom, že pravděpodobně bylo zpracováno na základě dat ve sloupci.
Stačí google, např.:site:wall.cz +elcha jedinečné +collection
@marjankaj
Možná. Ale v zadání je VBA. A otevírat soubor pomocí VBA přes TC - trochu zbytečné ;)).
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.