excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Rozsah- Limitovanie hodnôt v stĺpci
MS Excel
Téma: Rozsah- Limitovanie hodnôt v stĺpci 
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
(17.7.2016 15:20)#032056
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
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
"Žá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 SubJe 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
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 SubJe 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
(18.7.2016 11:02)#032062
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
citovat
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
citovatUživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články