< návrat zpět

MS Excel


Téma: Změna pořadí rss

Zaslal/a 6.2.2013 18:38

Ahoj, potřeboval bych poradit s níže uvedeným kódem. Nyní je nastaveno, že se data z UF uloží na další volný řádek. Lze nastavit, aby se nový zápis zapsal na první řádek a starší data se posouvala dolů. Je to možné? Díky za radu.

Private Sub CommandButton1_Click()
Dim list As String
list = ActiveSheet.Name

Sheets("Odběratel").Select
Dim Pocet_zaznamu, A, Novy_zaznam As Integer
Dim start, nazev, jmeno, ulice As String

Pocet_zaznamu = 490000
start = 1

For A = 1 To Pocet_zaznamu

nazev = Cells(start, 1)
jmeno = Cells(start, 2)
ulice = Cells(start, 3)
mesto = Cells(start, 4)
psc = Cells(start, 5)
telefon = Cells(start, 6)
ic = Cells(start, 7)
dic = Cells(start, 8)
Email = Cells(start, 9)
web = Cells(start, 10)

If nazev <> "" Or jmeno <> "" Or ulice <> "" Or mesto <> "" Or psc <> "" Or telefon <> "" Or ic <> "" Or dic <> "" Or Email <> "" Or web <> "" Then
start = start + 1
Else
Novy_zaznam = start
'MsgBox "Nový řádek = číslo " & start
GoTo 1
End If
Next A
1: 'MsgBox "Nový řádek = číslo " & start
If nazev_f = "" Then
Odpoved = MsgBox("Musíš zadat název odběratele", vbInformation + vbOKOnly, "Pozor")
nazev_f.SetFocus
If Odpoved = vbOK Then Exit Sub
Else
End If

If nazev_f = "" Then
Cells(start, 1) = "---"
Else
Cells(start, 1) = nazev_f
End If

If jmeno_f = "" Then
Cells(start, 2) = "---"
Else
Cells(start, 2) = jmeno_f
End If

If ulice_f = "" Then
Cells(start, 3) = "---"
Else
Cells(start, 3) = ulice_f
End If

If mesto_f = "" Then
Cells(start, 4) = "---"
Else
Cells(start, 4) = mesto_f
End If

If psc_f = "" Then
Cells(start, 5) = "---"
Else
Cells(start, 5) = psc_f
End If

If telefon_f = "" Then
Cells(start, 6) = "---"
Else
Cells(start, 6) = telefon_f
End If

If ic_f = "" Then
Cells(start, 7) = "---"
Else
Cells(start, 7) = ic_f
End If

If dic_f = "" Then
Cells(start, 8) = "---"
Else
Cells(start, 8) = dic_f
End If

If email_f = "" Then
Cells(start, 9) = "---"
Else
Cells(start, 9) = email_f
End If

If web_f = "" Then
Cells(start, 10) = "---"
Else
Cells(start, 10) = web_f
End If
Unload NovaEvidence

Worksheets(list).Activate

End Sub

stop Uzamčeno - nelze přidávat nové příspěvky.

#011445
Opičák
Určitě to lze, ale lepší by bylo vidět UForm a co to má dělat, než kod. Proměnný jsou deklarovaný jako Variant, pokud je oddělíš čárkou.citovat
#011451
avatar
Zde je ukázka s UserFormem
Příloha: rar11451_odberatel.rar (18kB, staženo 24x)
citovat
#011453
Opičák
Napsal jsem to jinak, tohle mi nefungovalo.
Příloha: zip11453_kopie-odberatel.zip (40kB, staženo 24x)
citovat
#011456
avatar
Klobouk dolů, funguje dle představ, děkuji. Jen ten "error" ohledně dosaženého počtu řádků tam asi nevyužiji. Ještě jednou díky moccitovat
#011471
avatar
Ještě taková maličkost. Vložil jsem do UF ComboBox a potřeboval bych aby načetl data (A1:A5) z listu Typ a následně byl výběr z comba uložen rovněž do listu odběratel. Prosím o pomoc...předem díky
Příloha: rar11471_kopie-odberatel.rar (36kB, staženo 24x)
citovat
#011479
Opičák
1
Příloha: zip11479_kopie-odberatel_cbox.zip (39kB, staženo 24x)
citovat
#011506
avatar
Super, díky moc:-)citovat

Uživatelské menu

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

Menu

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.

Aktivní diskuse

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 0:34

Vynásobit hodnoty kurzem - Power Query

Alfan • 24.4. 16:32

Relativní cesta - zdroje Power Query

Alfan • 24.4. 15:44

Relativní cesta - zdroje Power Query

elninoslov • 24.4. 14:26

Jak odstraním duplicitní údaje

Mirek8 • 24.4. 12:13

Jak odstraním duplicitní údaje

elninoslov • 24.4. 8:57

Vyhledej

PavDD • 24.4. 8:56