< návrat zpět

MS Excel


Téma: Evidence objednávek rss

Zaslal/a 2.7.2015 9:18

Dobrý den,

vedu seznam položek k objednání v listu seznam. Potřeboval bych vymyslet makro, kdy bych to kolonky "Objednat kusů" napsal počet kusů k obednání a následně kliknul na vedlejší buňku (rád bych, aby to bylo na bunku a ne na tlačítko) a tím by se údaje z dané řádky překopírovaly do vedlejšího listu s názvem "objednávky". A další, aby se štosovaly pod sebou. Dokázal by mi někdo prosím pomoci?

Děkuji moc

Příloha: zip25763_objednavky.zip (11kB, staženo 63x)
Zaslat odpověď >

#025765
avatar
možné řešení...
Příloha: zip25765_objednavky1.zip (17kB, staženo 108x)
citovat
#025771
elninoslov
No ja som to pochopil tak, že sa majú pridávať ďalšie a ďalšie na koniec druhého listu. A to by som urobil asi nejak takto:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim R As Long
With Worksheets("seznam")
R = .Cells(Rows.Count, 2).End(xlUp).Row - 1
If R > 0 Then
If Not Intersect(Target, .Cells(2, 9).Resize(R)) Is Nothing Then
With Worksheets("objednavky")
R = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If R = 2 Then .Cells(R, 1) = "001" Else .Cells(R, 1) = Right("00" & CInt(.Cells(R - 1, 1) + 1), 3)
.Cells(R, 2).Resize(1, 7).Value = Worksheets("seznam").Cells(Target.Row, 2).Resize(1, 7).Value
End With
End If
End If
End With
End Sub

Doriešte si ešte formátovanie ďalších riadkov.citovat
#025773
avatar
Děkuji moc oběma, systém elninoslov je úplně super, přesně, co jsem potřeboval. Ještě bych se jen zeptal, kdybych ta data nechtěl kopírovat do vedlejší záložky "Objednávky", ale to vedlejšího souboru, který je ve stejné složce, bylo by to technicky možné? Aby se soubor třeba otevřel, makro do něj poslalo daný řádek a zase se soubor zavřel a první soubor by zůstal otevřený...umožňuje to vůbec excel?

Ještě jednou moc děkujicitovat
#025783
elninoslov
To by malo ísť cez ADO, to Vám ale ja urobiť neviem, takže jedno "krkolomnejšie riešenie" cez Excel.Application. Musí to byť globálna premenná, ktorá je stále inicializovaná, lebo ak by sa vytvárala pri každom kliku, program by bol rýchlostne nepoužiteľný. Takto tú 0,5 sekundy pretrpíte len raz pri otváraní zošitu. Upravil som Vám formát 1000 riadkov na taký aký ste mali v prvých 2 v príklade. Rovnako aj automatické podmienené formátovanie na farbu a orámovanie, a aj vzorec do posledného stĺpca, ktorý vloží text upozorňujúci na kliknutie.

Ako to funguje ?
-pri otvorení seznnam.xlsm, sa vytvorí ešte jedna virtuálna inštancia Excel, v ktorej sa otvorí objednavky.xlsx. Vy to nevidíte, ale to v pamäti otvorené. Teraz nieje problém prenášať údaje.
-ak počas otvoreného seznam.xlsm budete chcieť otvoriť aj objednavky.xlsx tak Vás to upozorní, že zošiť je otvorený a môžete ho otvoriť iba na čítanie.
-kliknutie na bunku, potom len skopíruje data, nemusí vytvárať ani rušiť tú inštanciu Excel, tá sa zruší pri zatvorení zošitu seznam.xlsm automaticky.
-súbor objednavky.xlsx sa ukladá priebežne po každom kliku.
-ak by normálna aplikácia Excel spadla, zostane v pamäti proces Excel.exe, ktorý bude treba zrušiť v Správcovi úloh.

Vyskúšajte, či Vám to bude vyhovovať a stačiť.
Viac neviem pomôcť.
Příloha: rar25783_objednavky.rar (68kB, staženo 62x)
citovat
#025786
avatar
zdá se mi nepraktické každou položku zapsat extra..
na c:\ vytvoř adresář "a" nebo si uprav makro
Příloha: zip25786_a.zip (27kB, staženo 56x)
citovat
#025787
elninoslov
No neviem, neviem, urobil som asi 20 zápisov, a začalo to byť pomalé :(.
Máte tam chybku, v druhom Application.DisplayAlerts = False, má byť True.
Aby Open okno nepreblikovalo treba ešte pridať Application.ScreenUpdating = False. Veľmi to spomaľuje zvolený druh výpočtu počtu riadkov. Nerieši sa tam ešte to ID. Treba ošetriť kliknutie na prvý riadok. Prenáša sa aj slovo "klik".
Takže asi by som to upravil takto:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim a(), r As Long
If Target.Row > 1 And Target.Column = 9 Then
With Application
.ScreenUpdating = False
On Error GoTo Chyba
Workbooks.Open ThisWorkbook.Path & "\obj.xlsx"
With Worksheets("objednavka")
a = ThisWorkbook.Worksheets("seznam").Rows(Target.Row).Resize(1, 8).Value
r = .Cells(Rows.Count, 1).End(xlUp).Row + 1
a(1, 1) = Format(r - 1, "000")
.Rows(r).Resize(1, 8).Value = a
End With
.DisplayAlerts = False
ActiveWorkbook.Close True
Chyba:
.DisplayAlerts = True
.ScreenUpdating = True
End With
End If
End Sub
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

On-line nástroje