Zaslal/a
21.2.2013 9:06Dobrý den
Používám makro které mi přiřazuje to tabulky vyexportované hodnoty ze SAPU.
Vyhledá hodnotu dle indexu, zapíše do příslušného pole a řádek smaže.
Pokud stejný index nenajde, řádek ponechá a přeskočí na další.
Vše fungovalo donedávna bez problému, ale jak jde čas a rozrůstají se indexační kódy, začala nepříjemná věc a to slučování hodnot.
Např. u indexu 1040 dojde k jeho vyhledání i zapsání do příslušné pozice bez konfliktu, problém nastává u indexu 104090 a dalších, které mají společnou část (v tomto případě 1040), veškeré hodnoty se zapíší k první vyhledané shodě
Dokážete někdo tohle makro opravit, začíná mi to trochu přerůstat přes hlavu a sám si nevím rady.
Makro mi totiž psal před lety kamarád a já si dokážu leda tak změnit rozsah a pozice.
předem děkuji
Dim I As Integer, m As Byte
Const k = 380
------------------------------------------------
Sub Nacti_SKLAD()
Range("O6").Select
Workbooks.Open Filename:="c:\Documents and Settings\SapWorkDir\sklad.xls"
Windows.Arrange ArrangeStyle:=xlTiled
Range("A1").Select
Columns("B:B").EntireColumn.AutoFit
Columns("O:O").EntireColumn.AutoFit
Krokovani
Windows("Stav skladu.xlsm").Activate
Range("A1").Select
End Sub
---------------------------------------------------------------
Sub Krokovani()
Range("A1").Select
rowlast = Range("A1").End(xlDown).Row
For I = 1 To rowlast
m = 0
a = ActiveCell.Value
ActiveCell.Offset(0, 2).Activate
b = ActiveCell.Value
Windows("Stav skladu.xlsm").Activate
With Worksheets(1).Range("b6:b" & k)
Set c = .Find(a, LookIn:=xlValues, SearchOrder:=xlByColumns)
If Not c Is Nothing Then
Range(c.Address).Select
ActiveCell.Offset(0, 13).Activate
ActiveCell.Value = ActiveCell.Value + b
Windows("sklad.XLS").Activate
Selection.EntireRow.Delete
ActiveCell.Offset(0, -2).Activate
m = 1
Else
With Worksheets(1).Range("c6:c" & k)
Set c = .Find(a, LookIn:=xlValues)
If Not c Is Nothing Then
Range(c.Address).Select
ActiveCell.Offset(0, 13).Activate
ActiveCell.Value = ActiveCell.Value + b
Windows("sklad.XLS").Activate
Selection.EntireRow.Delete
ActiveCell.Offset(0, -2).Activate
m = 1
Else: Windows("sklad.XLS").Activate
End If
End With
End If
End With
If m = 0 Then ActiveCell.Offset(1, -2).Activate
Next I
End Sub
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.