Příspěvky uživatele

Tak místo toho End dej Exit Sub

Hledá prázdný řádek ve sl C od spodu,
pokud vše smažeš tak první položka se zapíše do řádku 22, ale jelikož je sloučený, jak sem si teď všim, tak tam nic není. Dej něco do toho skrytého řádku 23 a je po problému

co je přesně v tom TB
- je tam toto 018-9.11.2013 nebo už to je nějaká složenina?

První část kódu

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim strWhat As String, lb As MSForms.ListBox
- slovo co se bude hledat
strWhat = TextBox1.Text
Set lb = ListBox1
- list na kterém se bude hledat
Dim arrLists, l
arrLists = Array("Položky")
-počet sloupcu co se zobrazí v LB
lb.Clear
lb.ColumnCount = 3
For l = LBound(arrLists) To UBound(arrLists)
-zavolani fce s parametry
FindTextStartedWith strWhat, arrLists(l), lb
Next
End Sub

fce.

Sub FindTextStartedWith(ByVal WhatText As String, ByVal ListWhere As Variant, lb As MSForms.ListBox)
Dim r As Range, c As Range, firstAddress
-hvězdičky jako zástupný znak
'pridano aby hledalo vse co obsahuje
WhatText = "*" & WhatText & "*"
-hledat ve sloupci B na listě co se zadl výše
With Worksheets(ListWhere).Columns("B")
Set c = .Find(WhatText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

- nalezené shody přidej do pole
If Not c Is Nothing Then
firstAddress = c.Address
Do
If UCase(c.Value) Like UCase(WhatText) & "*" Then
If r Is Nothing Then
Set r = c
Else
Set r = Application.Union(r, c)
End If
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

If Not r Is Nothing Then
For Each c In r

-přidávání shod do seznamu LB
If Not c.Value = "Název položky" Then
lb.AddItem c.Value
lb.Column(lb.ColumnCount - 1, lb.ListCount - 1) = c.Offset(0, 1).Value
lb.Column(lb.ColumnCount - 2, lb.ListCount - 1) = c.Offset(0, 4).Value
End If

Next
End If
End Sub

zkus třeba
DATA.Offset(0, 3).Value = Format(Mid(TextBox1, 5, 10), "yyyymmdd")

Tak graf dej na jiný list a list s daty skryj.

Co třeba takto
DATA.Offset(0, 3).Value = TextBox1.Value

Najdi v kódu to mezi if a pak nahraď/uprav na toto
If Not c.Value = "Název položky" Then
lb.AddItem c.Value
lb.Column(lb.ColumnCount - 1, lb.ListCount - 1) = c.Offset(0, 1).Value
lb.Column(lb.ColumnCount - 2, lb.ListCount - 1) = c.Offset(0, 4).Value
End If

Když napíšeš část položky a dáš entr nebo se přepneš do jiného políčka UF tak to nalezne vše ze sloupce B listu Položky
Když klikneš na položku a dáš vložit tak se to vloží na list Nabídka
Koukni a uvidíš

Nevím zda je to přesně ono
http://office.microsoft.com/cs-cz/excel-help/vytvoreni-datoveho-souboru-xml-a-souboru-schematu-xml-z-dat-tabulky-HA010263509.aspx

nebo http://patrickyong.wordpress.com/2008/01/14/excel-mapping-to-xml-schema/

Třeba
Sub makro()
Dim Wsht As Worksheet
' pro vsechny listy mimo list1
For Each Wsht In ThisWorkbook.Worksheets
If Wsht.Name <> "List1" Then
With Wsht
' smaz radek
.Rows(5).Delete
End With
End If
Next
End Sub

Mě to Dingovo smaže řádek na všech listech pokud se dá delete místo clear...

Použij fci SVYHLEDAT
http://office.lasakovi.com/excel/funkce/funkce-vyhledavaci-svyhledat-vvyhledat/

Tady je jiné řešení.
Je tam volba přepsání a smazání jak ses ptal výše.

Mě to žádnou chybu nevyhazuje když ten kod vlozim do modulu harku2.
Do přílohy jste ten kod nedal, takze nevim.

Ted zalezi na Vas co vlastne od toho chcete.
Bud tim Opicakovzm resenim nebo mym a nebo to chcete zkombinovat?
Ptate se na obe reseni.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje