Příspěvky uživatele
< návrat zpět
Určo by bylo asi lepší jak říkáš.. :-) kdybys dal ješte jeden sloupec a tam jen písmenko dodavatele...
Copak jsme v mateřské školce? 
Já se ti pak pokusím udělat takový makro v kterým nebudeš nic měnit pokud budeš mít nového dodavatele ;-)
tak tady máš tu mojí verzi :-D ale ješte to je potřeba vypilovat podle sebe.
To je jen takový šup tam a nic... :))
A popravdě se mi zavírají oči, tak sna to bude aj fungovat:)
můžeš jsem prosím dát nějaký vzor ? Z Toho to moc nechápu :o)
zdravím,
k tomu přesuntím políčka do určitého listu dodavatele bych třeba použil toto makro, které si spoust na skladu který chceš roztřídit.
Sub presun()
Dim radek As Long
Dim sloupec As Long
Dim list As Worksheet
Dim novylist As Worksheet
Set list = ActiveSheet
For radek = 2 To list.Cells(65000, 1).End(xlUp).Row
If Cells(radek, 1).Interior.Color = 255 Then
Set novylist = Sheets("A")
GoTo 1
ElseIf Cells(radek, 1).Interior.Color = 65535 Then
Set novylist = Sheets("B")
GoTo 1
ElseIf Cells(radek, 1).Interior.Color = 15773696 Then
Set novylist = Sheets("C")
GoTo 1
Else
MsgBox "Pro " & Cells(radek, 1).Value & " nemáte uvolněn list dodavatele", vbInformation
GoTo 2
End If
1:
novyradek = novylist.Cells(65000, 1).End(xlUp).Row + 1
For sloupec = 0 To 8
novylist.Cells(novyradek, 1).Offset(0, sloupec) = list.Cells(radek, 1).Offset(0, sloupec)
Next sloupec
2:
Next radek
MsgBox "Hotovo :o)", vbInformation
End Sub
toto makro si můžeš dát i pod nějaké tlačítko u každého skladu
Sub vyhledej()
Dim hledat As String
On Error GoTo 1
hledat = Application.WorksheetFunction.Match(Range("A1").Value, Range("D:D"), 0)
MsgBox hledat
Exit Sub
1:
MsgBox "Zadaná hodnota není v seznamu", vbInformation
End Sub
zatím to mám zapsané takhle ale tento zápis je podle mě nepřijatelný.
Spíš potřeboval něco i jako když tam ta hodnota nebude tak udělej to a to jinak to a to...
Zdravím.
Řeším ted toto:
Potřebuji makro, které mi vyhledá hodnotu v buňce A1 ve sloupci D.
Pokud tam daná hodnota bude tak se zobrazí msgbox "ANO" a pokud tam nebude tak se zobrazí "NE".
Zkousím to pomocí match ale hazí to chybu pokud tam ta hodnota není.
Pomůžu mi někdo prosím?
N.
možná vím. Máš aktivovaný list kody a nebo nacrt?
Měj aktivovám list nacrt. Zkus to.
pošli mi ten soubor podívám se na to
Tak co myška, žije?
Tady je můj kod pro porovnáníSub vypiskody()
Dim kod As Long
Dim novyradek As Long
Dim nacrtlist As Worksheet
Dim kodylist As Worksheet
kod = 1
novyradek = 3
Set nacrtlist = Sheets("nacrt")
Set kodylist = Sheets("kody")
Do Until Sheets("kody").Cells(kod, 1) = ""
With nacrtlist
.Cells(novyradek, 8) = kodylist.Cells(kod, 1)
.Range(Cells(novyradek, 8), Cells(novyradek + 1, 10)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection.Font
.Name = "Calibri"
.Size = 18
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
kod = kod + 1
novyradek = novyradek + 14
Loop
End Sub
jo takhle si mohl říct hned 
Já ted nemužu, možná zítra bych ten kod ti vytvořil ale ted už fakt nemužu.
Nebo ješte zkoušej, raz to určo výjde :-D
Není zač, mě to taky někdo někdo šikovný naučil ;-)
Jinak pro sloučení buněk slouží "merge"
Třeba takto: Range(cells(10, 10), cells(10, 11)).Merge
Pokud to chceš mít ješte uprostřed zkus si zapnout nahrávání makra a sluč nějaké buňky a uvidíš jaký kód ti to vypíše
A to aby se to generovalo pod sebe to jsem nepochopil jak to myslíš 
aloha
já bych to vyřešil třeba pomocí makra tím to kódem:
Sub vypiskody()
Dim kod As Integer
Dim list As Integer
Dim kody As Worksheet
Set kody = Sheets("kody")
kod = 1
list = 1
Sheets("kody").Activate
Do Until kody.Cells(kod, 1) = ""
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "nacrt" & list
ActiveSheet.Cells(10, 10) = kody.Cells(kod, 1)
ActiveSheet.Cells(20, 10) = kody.Cells(kod + 1, 1)
ActiveSheet.Cells(30, 10) = kody.Cells(kod + 2, 1)
ActiveSheet.Cells(40, 10) = kody.Cells(kod + 3, 1)
kod = kod + 4
list = list + 1
Loop
End Sub
před spustěním tohoto makra si smaž list "nacrt"
Snad jsem to tak pochopil.
Mno jak jsem psal. V originále budu mít cca strojů 300 a postupně budou i přibívat, takže tak :) a něž by si vše prohlídnul bych kolečku u myšky vykroutil :o) A myslím si že v tom textboxu by to bylo přehlednější. Pokud tam nebudou velká písmena samo...
Zdravím a přeji hezký den
Mám tu zase jedno pro mne zatím nevyřešitelné.
V příloze posílám sešit, kde mám vypsaný přehled strojů a jejich údržby dle intervalů(denně, týdně, ročně, atd.) a co je potřeba udělat v tom intervalu(podle sloupce "L".
Potřeboval bych nějaký userform kde by byl nějaký textbox, který by mi po spuštění userformu projel všechny stroje (v originálu cca 300 strojů) a nahlásil jakou údržbu je nutno provést v intervalech - týdně, měsíčně, půlročně, ročně a revizi.
Pokud u daného stroje nebudete nutné udělat nějakou údržbu tak at se ani v textboxu neukáže. Ale tohle není potřeba. Stačí mi třeba jen v textboxu seznam strojů a vypsány údržby. Pokud tedy nebude nutná žádná udržby tak bude mít u intervalu prázdnou hodnotu.
Pokud v sloupci "L" je hodnota 0, značí že není potřeba žádná údržba v intervalu.
Mno tak nějak už z toho nejsem chytrý :D
Pokud se najde někdo kdo by mi s tím pomohl byl bych moc rád.
N.
určitě by to nějak šlo. Zkus sem dát příklad ale nic neslibuji
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články