Příspěvky uživatele
< návrat zpět
Private Sub tbProdejEAN_AfterUpdate()
Dim v
v = ufProdej.tbProdejEAN.Value
' vložim vzorec
Range("A1").FormulaR1C1 = "=VLOOKUP(" & ufProdej.tbProdejEAN.Value & ",'Sklad'!C2:C3,2,0)"
' Zapíšu výsledek kde patří
ufProdej.tbZk.Value = v
End Sub
Je to od pasu ... když tak jsi to uprav. R.
Podle mne je řešení jiné.
1. Můžeš před Close vložit Application.CutCopyMode = False
2. Stačí abys nějakou buňku označil za aktivní Range("A1").Select ... tím se zruší označená oblast a můžeš ukládadat. ActiveWorkbook.Close Savechanges:=False
R.
Třeba ...
If StrComp(Range("A1").Value, "") = 0 Then
Debug.Print "je to prazdne1"
End If
If Range("A1").Value = "" Then
Debug.Print "je to prazdne2"
End If
Do buňky nepíšeš ale přiřazuješ hodnotu
Range("A1").Value = "Ahoj"
Cells(radek,sloupek).Value = "Ahoj"
If Range("A1").Value = 5 then
MsgBox "Je tam pětka"
else
MsgBox "Není tam pětka"
End if
If Cells(radek,sloupek).Value = 5 then
MsgBox "Je tam pětka"
else
MsgBox "Není tam pětka"
End if
Nebo vkládáš vzorec
Range("A1").FormulaRC = "=AND(R1C1,R2C2)"
printf sice VBA nemá ale něco podobného je funkce Format()
v případě porovnání textu v buňce se používá
If StrComp(Range("A1").Value = "AHOJ") = 0 then
MsgBox "Je tam AHOJ"
else
MsgBox "Není tam AHOJ"
End if
R.
A - Vyrobek
B - Datum (setříděný)
C - Požadavek na vyrobu
D - Vyrobene kusy
Makro dopis_vyrobu(vyrobek As String, nove_kusy As Long)
vyrobek := Text ve sloupci A
nove_kusy := počet kusu, které se mají rozdělit.
Makro Test_vyroby()
Vzorove spuštění - musíš ošefovat čtečku a hodnoty podle tohoto vzoru pouštět do makra "dopis_vyrobu"
Stačí takto ?
Option Explicit
'--------------------------------------------------------'
Sub dopis_vyrobu(vyrobek As String, nove_kusy As Long)
'--------------------------------------------------------'
Dim c As Range
Dim s As String
Dim Sl_vyroby As Long
Dim Sl_pozadavek As Long
Dim pozadavek As Long
Dim vyrobeno As Long
Dim rozdil As Long
Sl_vyroby = 3 ' sloupek D
Sl_pozadavek = 2 ' sloupek C
With ActiveSheet
With Range("A1:A" & Range("A65536").End(xlUp).Row)
Set c = .Find(vyrobek, LookIn:=xlValues)
If Not c Is Nothing Then
s = c.Address
Do
vyrobeno = c.Offset(0, Sl_vyroby).Value
pozadavek = c.Offset(0, Sl_pozadavek).Value
' nejdrive otestuji, jestli vyroba odpovida pozadavku
' pokud ANO pak neni nutne pripisovat kusy
If pozadavek > vyrobeno Then
rozdil = pozadavek - vyrobeno
' pokud je kusu mene nebo presne pak ...
If nove_kusy <= rozdil Then
c.Offset(0, Sl_vyroby).Value = vyrobeno + nove_kusy
nove_kusy = 0
Else
' pokud je kusu vice pak ...
c.Offset(0, Sl_vyroby).Value = vyrobeno + rozdil
nove_kusy = nove_kusy - rozdil
End If
End If
Set c = .FindNext(c)
' najdeme dalsi vyskyt vyrobku
Loop While Not c Is Nothing And c.Address <> s And nove_kusy <> 0
Set c = Nothing
End If
End With
End With
End Sub
'--------------------------------------------------------'
Sub Test_vyroby()
'--------------------------------------------------------'
Call dopis_vyrobu("xxx..yyy", 3)
End Sub
'--------------------------------------------------------'
Vícenásobně to je možné počítat přes makro a vzorce DSUMA. Uděláš si kostru na jeden výpočet v cyklu procházíš plán a počítáš co tě zajímá, výsledek zapíšeš do daného řádku. Pokud se týče čtečky, pak to většinou nebývá přímo spojené s EXCELEM ale máš nějaký výrobní lowlevel a čtečka je napojená na něj. Z vyššího levlu pak ovládáš provoz a můžeš si i načíst data do excelu. Pak Ti stačí přístup přes ODBC (ADO) na data nebo cokoli podobného na načtení do EXCELU. Pokračuj ... R.
Pokud máš stejné materiály a zajímátě součet na sklaě nebo potřebný součet k výrobě apod, pak místo SVYHLEDAT použij SUMIF (nenapadlo mne, že používáš stejná data). R.
V tom pl.xls máš 3 listy. Na prvním máš tabulku a vzorce. Do druhého listu si vlož pod sebe obsahy ze 4 souborů ... Je jedno jak je nakopíruješ, jen dodrž, že logicky budou data podsebou. Až to budeš mít, tak Ti stačí jen upravit na prvním listě vzorce. Jsou v pořádku jen ukazují na jiné oblasti, takže je oprav a bude Ti to fungovat. Jedinný problém by byl, kdyby celkové množství řádku bylo víc než 65536, pak by se muselo najít jiné řešení a nebo pokud máš OFF2007 pak zapnout podporu velkých oblastí ... to máš pak jeden mega řádků (počítáno ve dvojkové soustavě) ... 1 048 576.
R.
Je nutné aby zdroj byl v externích souborech ??? Pokud né tak to nakopíruj do jednoho listu a použij stejné vzorce s jinými odkazmi. Myslím si, že je to jednodužší než kousat části a pak podle toho vyhledávat jméno souboru.R.
Otázky jsou nutné, když nepodáš vysvětlení co Ti nejde.
Chybu máš v logice ... používáš FOR I = 1 atd.
Máš krok kdy i = 28 řádek se zazelená a v kroku 29 se znovu začerní. Přečti si předchozí příspěvek a použij for each a nemusíš řešit přeskakování sloučených buněk. R.
Přiznám se, že příkladu moc nerozumím.
- Príklad je slabý, jako vzorek dat. Chtělo by to naplnit hodnotami nebo sloučit oblasti.
- Místo testování oblasti, je lepší procházet v cyklu For each C in Range(oblast) a nemusí Tě zajímat sloučená pole.
- Proč nepoužiješ podmínění formátování ?
R.
Můžeš i makrem ... nejdříve si označ buňky.
Sub Cas_8()
For Each c In Selection
c.Value = Fix(CDate(c.Value)) + CDate("08:00")
Next c
End Sub
R.
Sub Kopirovat_a_transponovat()
Dim SetOfSesity
Dim SesitIt
Dim Sesit As Workbook
Dim Act As Workbook
SetOfSesity = Array("1.xls", "2.xls", "3.xls", "4.xls")
Set Act = ActiveWorkbook
i = 1
For Each SesitIt In SetOfSesity
Workbooks.Open SesitIt
'Debug.Print SesitIt.Name
Range("B1:B12").Copy
Act.Activate
Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
i = i + 1
Workbooks(SesitIt).Close False
Next SesitIt
End Sub
Např. =USEKNOUT(HODNOTA(A1))+HODNOTA("08:00")
Pokud potřebuješ text, pak použij SVYHLEDAT a vedle toho počet přes fce SUMIF. Obarvení přes fce JE.NEDF a podmíněné formátování. Je to snadné. Vyzkoušej.
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