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: Vložit řádek VBA
Ani táto nejde otvoriť.citovat
MS Excel
Téma: Vložit řádek VBA 
Zaslal/a Raders486 20.3.2018 11:21
Ahoj.
Chtěl bych požádat zda by se někdo nemohl podívat, jak prostřednictvím VBA vložit řádek pod řádky když je ve sloupcích "G"a"I" změna.
Děkuji
Radek
Příloha: 
39920_zakazky.rar (380kB, staženo 25x)
39920_zakazky.rar (380kB, staženo 25x)
39921_vloz-radek.png
-Takže keď nastane zmena v bunke G5 a zároveň zmena v bunke I5 tak sa medzi riadky 5 a 6 vloží nový riadok ?
-Alebo je to tak, že je jedno v ktorom nastane zmena, či v G alebo v I, vždy sa vloží za zmenu riadok ?
-Čo ak "zmena" znamená vymazanie bunky. Aj vtedy sa má vložiť riadok ?
-Ak nastane hromadná zmena, tak postupne povkladať riadky za každým riadkom zmeny? Alebo iba za skupinu zmien?
...citovat
-Alebo je to tak, že je jedno v ktorom nastane zmena, či v G alebo v I, vždy sa vloží za zmenu riadok ?
-Čo ak "zmena" znamená vymazanie bunky. Aj vtedy sa má vložiť riadok ?
-Ak nastane hromadná zmena, tak postupne povkladať riadky za každým riadkom zmeny? Alebo iba za skupinu zmien?
...citovat
Děkuji za rychlou reakci.
Postačí mi, když bude změna v tomto případě
Takže keď nastane zmena v bunke G5 a zároveň zmena v bunke I5 tak sa medzi riadky 5 a 6 vloží nový riadok ?
Děkuji
Radekcitovat
Postačí mi, když bude změna v tomto případě
Takže keď nastane zmena v bunke G5 a zároveň zmena v bunke I5 tak sa medzi riadky 5 a 6 vloží nový riadok ?
Děkuji
Radekcitovat
Určite ? Takýto prípad nastane iba pri kopírovaní hodnôt v 3 stĺpcoch a následnom vložení do stĺpcov G:I. A potom ešte pri nejakom hromadnom importe do celého listu/tabuľky.
Nechcete to náhodou tak, že:
Ak bola zmenená bunka v tabuľke v stĺpcoch G alebo I, skontroluje sa, či obe (G aj I) niesú prázdne, a ak niesú, tak sa vloží za ne riadok.
Potom sa dá ešte eliminovať aj to, že síce nastala zmena v G alebo I, ale zároveň je počet zmenených buniek v riadku rovnaký ako maximálny počet stĺpcov, a tak sa zistí, že išlo o pridanie/zmazanie celého riadku, vtedy nič nerobiť.
A keďže tam máte veľa Prepojení, tak ma ešte napadá, či náhodou "zmenou" nemáte na mysli to, že nejaká hodnota bola iná ako terajšia aktualizovaná (z nejakého prepojenia). A to je potom už komplikácia, lebo treba uchovávať kópie všetkých predošlých hodnôt po každej zmene čohokoľvek = pomalé.
Takže ešte upresnite.citovat
Nechcete to náhodou tak, že:
Ak bola zmenená bunka v tabuľke v stĺpcoch G alebo I, skontroluje sa, či obe (G aj I) niesú prázdne, a ak niesú, tak sa vloží za ne riadok.
Potom sa dá ešte eliminovať aj to, že síce nastala zmena v G alebo I, ale zároveň je počet zmenených buniek v riadku rovnaký ako maximálny počet stĺpcov, a tak sa zistí, že išlo o pridanie/zmazanie celého riadku, vtedy nič nerobiť.
A keďže tam máte veľa Prepojení, tak ma ešte napadá, či náhodou "zmenou" nemáte na mysli to, že nejaká hodnota bola iná ako terajšia aktualizovaná (z nejakého prepojenia). A to je potom už komplikácia, lebo treba uchovávať kópie všetkých predošlých hodnôt po každej zmene čohokoľvek = pomalé.
Takže ešte upresnite.citovat
Celá tabulka jak jí vidíte je výsledek procedury, která je volána cca 4x denně. To co je v příloze je výsledek.
Já bych opravdu potřeboval jen udělá to co jste psal.
1)Pokud je změna sloupci "G" = vlož řádek.
2)Pokud jsou čísla ve sloupci "G" stejná, ale vznikne odchylka ve sloupci "I" = vlož řádek.
To oddělování černými řádky co již v tabulce je,mám také v proceduře (zde však přesně definuji názvy "VIP", "Vyškov" atd.., pod kterými se má řádek vložit), tak nemám problém to co případně napíšete, vložit někam nad toto oddělování.
Vzor jak odděluji přesně definované názvy(moc se prosím nesmějte
)
Sub NajdiVIP()
HledanaHodnota = "VIP" 'zadej hledanou hodnotu
For i = 3 To 2000
rozsah = "R" & i 'zadej kde hledat
With Range(rozsah)
Set FoundCell = .Cells.Find(What:=HledanaHodnota, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
Else
FoundCell.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FormatConditions.Delete
ActiveCell.Range("A1:AB1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Exit For
End If
Next i
End Sub
S ostatním si asi poradím.
Děkujicitovat
Já bych opravdu potřeboval jen udělá to co jste psal.
1)Pokud je změna sloupci "G" = vlož řádek.
2)Pokud jsou čísla ve sloupci "G" stejná, ale vznikne odchylka ve sloupci "I" = vlož řádek.
To oddělování černými řádky co již v tabulce je,mám také v proceduře (zde však přesně definuji názvy "VIP", "Vyškov" atd.., pod kterými se má řádek vložit), tak nemám problém to co případně napíšete, vložit někam nad toto oddělování.
Vzor jak odděluji přesně definované názvy(moc se prosím nesmějte
)Sub NajdiVIP()
HledanaHodnota = "VIP" 'zadej hledanou hodnotu
For i = 3 To 2000
rozsah = "R" & i 'zadej kde hledat
With Range(rozsah)
Set FoundCell = .Cells.Find(What:=HledanaHodnota, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
Else
FoundCell.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FormatConditions.Delete
ActiveCell.Range("A1:AB1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Exit For
End If
Next i
End Sub
S ostatním si asi poradím.
Děkujicitovat
Sub aaa()
stlpec = 9
first = ActiveSheet.UsedRange.Row
last = ActiveSheet.UsedRange.Rows.Count + first - 1
For i = last To first + 1 Step -1
If (Cells(i, stlpec) <> Cells(i - 1, stlpec)) Then
Cells(i, stlpec).EntireRow.Insert
Cells(i, stlpec).Interior.ColorIndex = 6
End If
Next i
End Sub
Snáď si to upravíš sám, keď si nedal prílohu.citovat
stlpec = 9
first = ActiveSheet.UsedRange.Row
last = ActiveSheet.UsedRange.Rows.Count + first - 1
For i = last To first + 1 Step -1
If (Cells(i, stlpec) <> Cells(i - 1, stlpec)) Then
Cells(i, stlpec).EntireRow.Insert
Cells(i, stlpec).Interior.ColorIndex = 6
End If
Next i
End Sub
Snáď si to upravíš sám, keď si nedal prílohu.citovat
Děkuji za snahu.
Příloha je celou dobu v požadavku.
Nicméně napsaný kód nedělá to co by měl.
aad1) pracuje i se skrytými řádky
add2) pokud je ve sloupci "H"číslo, tak požadovaný řádek nevloží
I tak jsem se snažil napsaným kódem inspirovat, ale to je již pro mě vyšší dívčí
Pokud by se našel někdo, kdo by se tomu chtěl po věnovat, přikládám opět přílohu.
Děkuji
Radek
Příloha je celou dobu v požadavku.
Nicméně napsaný kód nedělá to co by měl.
aad1) pracuje i se skrytými řádky
add2) pokud je ve sloupci "H"číslo, tak požadovaný řádek nevloží
I tak jsem se snažil napsaným kódem inspirovat, ale to je již pro mě vyšší dívčí
Pokud by se našel někdo, kdo by se tomu chtěl po věnovat, přikládám opět přílohu.
Děkuji
Radek
Příloha: 39955_dispeceri-chybejici-material-rousinov.rar (158kB, staženo 33x)
citovat39955_dispeceri-chybejici-material-rousinov.rar (158kB, staženo 33x)Radek-Klepacek napsal/a:
Pokud by se našel někdo, kdo by se tomu chtěl po věnovat, přikládám opět přílohu. Děkuji
RadekPříloha: 39955_dispeceri-chybejici-material-rousinov.rar (158kB, staženo 2x)
Už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