V priloze.
Makro soubor je treba mit v jine slozce nez upravovane sesity.
Pokud neni ListA ani ListB nebo naopak jsou oba listy, makro sesit preskoci.
Zkuste jestli bude pro vas fungovat.
(zkousejte na zalohovanych sesitech)
s.
Me to funguje bez problemu. Pripinam vysledek slouceni.
Tak mate spatne nastavene parametry v macro souboru nebo zdrojove soubory.
Ja si vytvoril 2 soubory (v obou celkem 2 radky, kde prvni radka je hlavicka, a celkem 4 sloupce) a macro probehne perfektne.
Zkontrolujte, ze mate spravne nastaveno... Jinak bude treba prilozit alespon 2 zdrojove soubory na ukazku.
syd
Zkuste prilozeny soubor.
Ze zdrojoveho souboru bude brat prvni list v poradi, bez zadne vazby na nazev sesitu ci listu.
Nebylo testovano, tak dejte vedet.
syd
Zdravim,
varianta podle popisu AL pres RemoveDuplicates:
Sub test()
With Range("D7")
.CurrentRegion.ClearContents
Range("B4").CurrentRegion.Rows(4).Rows(1).Copy
.PasteSpecial xlPasteValues, Transpose:=True
.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
.Sort key1:=.CurrentRegion, Order1:=xlAscending
.Select
End With
End Sub
No staci pridat jednoduchou kontrolu, pred tim, nez vlozime datum...
'...
If ws.Range("B" & ws.Rows.Count).End(xlUp).Row <> 1 Then
ws.Range("B2:B" & lr).SpecialCells(12).Value = Date
End If
'...
syd
Uprava pro uverejnenou ukazku.
Sub RK()
Dim ws As Worksheet
Dim lr As Long
Set ws = ActiveSheet
lr = ws.Range("D" & ws.Rows.Count).End(xlUp).Row
ws.AutoFilterMode = False
With ws.Range("A1:R" & lr)
.AutoFilter field:=1, Criteria1:=Array("1", "2", "3"), Operator:=xlFilterValues
.AutoFilter field:=2, Criteria1:="="
ws.Range("B2:B" & lr).SpecialCells(12).Value = Date
End With
ws.AutoFilterMode = False
End Sub
Zdravim Radku,
tim vasim VBA kodem urcite ne..
Ale treba takto:
Sub RK()
Dim ws As Worksheet
Dim lr As Long
Set ws = ActiveSheet
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
ws.AutoFilterMode = False
With ws.Range("A1:C" & lr)
.AutoFilter field:=1, Criteria1:=Array("1", "2", "3"), Operator:=xlFilterValues
.AutoFilter field:=2, Criteria1:="="
ws.Range("B2:B" & lr).SpecialCells(12).Value = Date
End With
ws.AutoFilterMode = False
End Sub
A to s tou podminkou, ze sloupec 'C' obsahuje data az do posledniho radku tabulky (tedy neobsahuje prazdne bunky).
syd
(mimochodem i clanek zde na wall http://wall.cz/excel-navod/regularni-vyrazy-v-excelu)
marjankaj napsal/a:
No jeden by si myslel, že DANÝ výraz(8ciferné číslo) je napríklad "12345678". No potom teda tento HĽADANÝ reťazec("12345678") proste vypíše.
Zdravim,
Sub TestRegExp()
' Z retezcu ve sloupci A vypise osmiciferne cislo do vedlejsi bunky
Dim r As Range, i As Long
With CreateObject("VBScript.regexp")
.Global = True
.Pattern = "(\d{8})"
For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
If .test(r.Value) Then
For i = 0 To .Execute(r.Value).Count - 1
r(, i + 2).Value = .Execute(r.Value)(i).submatches(0)
Next i
End If
Next r
End With
End Sub
syd
Zdravim,
zkusil jsem pomoci makra. Vyzkousejte a dejte vedet.
syd
Ja vedel, ze to bude jinak..
Tak mozna:
Sub Pepca()
With ActiveSheet
.Range("D2:D1000").NumberFormat = .Range("S1").Value & "-00-0000"
End With
End Sub
No, zkuste nasledujici kod vlozit do objektu List1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("S1") Then
If IsEmpty(Range("D2")) Then
Range("D2:D1000").NumberFormat = Target.Value & "-00-0000"
Else
Range(Range("D2").End(xlDown)(2), Range("D1000")).NumberFormat = Target.Value & "-00-0000"
End If
End If
End Sub
Pro stavajici data zustane format zachovan a novy se nastavi od prvni prazdne bunky do D1000.
syd
Jen hadam... nevim, zda tabulka ma 1 sloupec nebo vic..
V priloze ukazka vyhledavani po jedne polozce, nebo vice polozek najednou.
syd
Napr. zde.
syd
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.