Příspěvky uživatele

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.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje