< návrat zpět

MS Excel


Téma: Rozsah- Limitovanie hodnôt v stĺpci rss

Zaslal/a 15.7.2016 13:12

Zdravím,

trápim sa s VBA kódom už dlhší čas a neviem sa s ním pohnúť ďalej. Prosím o pomoc.
Kód:

Private Sub Worksheet_Calculate() 'Check if values haven't changed
If Range("F13").Value = Cells(Rows.Count, 1).End(xlUp).Value And _
Range("K13").Value = Cells(Rows.Count, 2).End(xlUp).Value Then Exit Sub

'Store the new values
Application.EnableEvents = False

If Range("F13").Value <> Cells(Rows.Count, 1).End(xlUp).Value And _
Range("F13").Value > 0 Then
Combining
End If

If Range("K13").Value <> Cells(Rows.Count, 2).End(xlUp).Value And _
Range("K13").Value > 0 Then
Combining
End If

Application.EnableEvents = True

End Sub

Sub Combining()
Dim NR As Long
NR = Range("A" & Cells(Rows.Count).Row).End(xlUp).Row + 1
Range("A" & NR).Value = Range("F13").Value
If NR > 48 Then
Range("A2:A48").Value = Range("A3:A49").Value
Range("A49").ClearContents
End If
End Sub


V makre Combining() v riadku If NR > 48 Then chcem dosadiť namiesto čísla 48, číslo vačšie ako 64 tak kód akoby sa "zasekol" a ostane v rozsahu A2:A64 a nepokračuje(nezapisuje) hodnoty ďalej(A65, A66,A67, A68...). Kód funguje správne, keď dosadím hodnotu (48 v napísanom kóde) menšiu ako 64. Skušal som po internete hľadať nejaké riešenia a našiel som tento kód (neviem, či to pomôže, možno áno)

Range("A" & Cells(Rows.Count, 1).Row).End(xlUp).Offset(1, 0).Value = Range("F13").Value

Ďakujem

Zaslat odpověď >

#032051
avatar
Moc tomu teda nerozumím :-).
Co přesně má to číslo 48 znamenat (jaká je logika výpočtu)?
P.citovat
#032056
avatar
Prvá časť kódu zapisuje hodnoty z bunky F13(z K13 to momentálne nevyužívam) do stĺpca A. Lenže potrebujem to ohraničiť, nechcem aby sa mi hodnoty zapisovali donekonečna, tak preto je tam vložené makro Sub Combining(). Toto makro vytvára hranicu(limituje) a čislo 48 v tomto kóde znamená, že makro nebude zapisovať hodnoty ďalej(A49, A50, A51, A52...) ako zadané číslo 48, takže to znamená hodnoty sú v rozmedzí A2:A48. Keby som napísal číslo 55 namiesto 48 , tak makro bude v rozmedzí A2:A55. Takže kód by vyzeral takto:
If NR > 55 Then
Range("A2:A55").Value = Range("A3:A56").Value
Range("A56").ClearContents

Ďalej, makro Combining() robí to, že ak už máme zapísané hodnoty v rozsahu A2:48 a nová hodnota(číslo z F13) sa zapíše do bunky A49 tak urobí toto Range("A2:A48").Value = Range("A3:A49").Value
Range("A49").ClearContents


Ako som už napísal, kód funguje správne ale iba keď dosadím čísla menšie ako 64 v riadku
If NR > 48 Then
a nechápem prečo to nefunguje aj s väčšími číslami ako 64.citovat
icon #032057
eLCHa
"Žádné" omezení tam není. Buď provádíte manuální úpravu kódu chybně nebo je v oblasti pro NR=65 a větší něco, co vás omezuje. Bez přílohy ovšem jen tipuji.

Pokud nechcete pro každé NR řešit úpravu obastí, proveďte to přes Offset + Resize. Poté zadáte velikost oblasti jen na jednom místě. Také zápis na buňku pod a poté posun nahoru je zbytečný - spouštíte 1 rekalkulaci navíc.
Něco takovéhoSub subCombining()
Const ciRECORDS_NUMBER As Long = 100

Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row

With Cells(2, 1).Resize(ciRECORDS_NUMBER, 1)
If iLastRow < .Row Then
iLastRow = .Row - 1
End If

If iLastRow < .Row + ciRECORDS_NUMBER - 1 Then
.EntireColumn.Cells(iLastRow + 1).Value = Range("F13").Value
Else
.Resize(ciRECORDS_NUMBER - 1, 1).Value = .Offset(1, 0).Resize(ciRECORDS_NUMBER - 1, 1).Value
.Cells(ciRECORDS_NUMBER, 1).Value = Range("F13").Value
End If
End With 'Cells(2, 1).Resize(ciRECORDS_NUMBER, 1)
End Sub
Je to jen v rychlosti a fungovalo to u mne správně. Sám bych to asi napsal úplně jinak, ale na tom teď nezáleží.citovat
#032062
avatar
kód funguje ako má ale vypadli tam niektoré veci s pôvodného kódu. Calculate metóda Private Sub Worksheet_Calculate()
a táto časť kódu
'Check if values haven't changed
If Range("F13").Value = Cells(Rows.Count, 1).End(xlUp).Value And _
Range("K13").Value = Cells(Rows.Count, 2).End(xlUp).Value Then Exit Sub
'Store the new values
Application.EnableEvents = False
If Range("F13").Value <> Cells(Rows.Count, 1).End(xlUp).Value And _
Range("F13").Value > 0 Then
Combining
End If
If Range("K13").Value <> Cells(Rows.Count, 2).End(xlUp).Value And _
Range("K13").Value > 0 Then
Combining
End If
Application.EnableEvents = True
End Sub


Som nečakal, že kód bude úplne prepísaný, takže som nešiel až tak do detailov čo sa týka prvej časti kódu(pôvodného kódu) zato sa ospravedlňujem, že to naťahujem a strácam váš čas.

V skratke: keď sa hodnota v F13 zmení, tak zapíš to do stĺpca A tak to môžete vidieť vo videu (vo videu som nič manuálne nerobil, hodnota z F13 je ťahaná z externého zdroja preto metóda calculate)

Link na download videa:
https://uloz.to/!7Hbv9uEV5/screencaptureproject2-mp4

ďakujem 1citovat

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

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09