asi takto:
Sub copy()
List2.Columns(1).ClearContents
For i = 2 To Cells(65000, 1).End(xlUp).Row Step 11
rada = ""
For j = 0 To 10
If Len(List1.Cells(i + j, 1)) > 0 Then
rada = rada & List1.Cells(i + j, 1) & ","
End If
Next j
' zapis do listu2
If Len(List2.Cells(1, 1)) = 0 Then
List2.Cells(1, 1) = rada
Else
List2.Cells(List2.Cells(65000, 1).End(xlUp).Row + 1, 1) = rada
End If
Next i
End Sub
Tak jestli z tohohle popisu nekdo pochopil plne podstatu problemu, ma u me pivo.
...asi by to chtelo prilozit nejaky soubor a poradne to vysvetlit.
V kodu zadnej problem nevidim.
Zkousel jsem to a jde mi to rychle, mozna bude problem ve vytizeni procesoru...
Jinak fakt nevim.
Jde si definovat, na ktery radek se chcete posunout a pouzit toto:Radek = 36
ActiveWindow.SmallScroll Down:=Radek
Urcite to bude jednoduche nejaky kod vytvorit, v tom problem neni, jen bych potreboval vedet, co ma delat.
Obarveni aktivni bunky lze udelat tak, jak jsem napsal, ale pokud mate vybrany (coz kodem delate) nejakou oblast a k ni priradite .Interior.ColorIndex, tak se obarvi cela oblast)
Pokud potrebujete vybrat prvni prazdnou bunku ve sloupci, lze tu udelat takto:
cells(cells(1,1).end(xldown).row+1,1).select
abych rekl pravdu, tak nevim, co chcete kodem dosahnout, pokud vysvetlite, co ma kod delat, tak ho muzu zkusit napsat...
ten kod obarvi rozhodne jen aktivni bunku (leda, ze byste na zacatku nemel ActiveCell, ale nejakej Columns).
Pokud budete chtit, aby se bunka po zmene odbarvila, budete muset vlozit dalsi kod do modulu prislusneho listu:Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Target) = False Then
Target.Interior.ColorIndex = 0
End If
End Sub
ActiveCell.Interior.ColorIndex = 3
(3 je cervena...)
Tak Jeza byl rychlejsi, kazdopadne bych se primlouval za jeho reseni upraveni funkce SVYHLEDAT, protoze si myslim, ze bude rychlejsi kdyz zvazime rochazeni 13000 radku makrem.
Pokud vsak bude makro pohodlnejsi, prikladam svoji verzi...
do modulu prislusneho listu pridej toto:
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
Range("E8:e16").ClearContents
End If
End Sub
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
Range("E5").ClearContents
End If
End Sub
treba takto?
asi to uplne nechapu.
Chcete, aby zaskrtnuti checkboxu1 vymazalo bunku A2 a zaskrnutit checkboxu2 vymazalo bunku A1?
tu dalsi jsem uz nepochopil vubec. Chcete aby se v bunce, ktera je ve vyberu (ale neni aktivni), zobrazil text?
Nechapu souvislost...ani ucel
budete potrebovat nejake tlacitko,ke kteremu priradite makro v doplnku (neobjevi se v seznamu maker, musite napsat rucne jeho nazev)
Bunky, ktere mohou uzivatele menit pridejte do seznamu oblasti, ktere jsou povoleny k upravam a zamknete list - melo by to fungovat...
pokud budete trvat na makru, tak by to slo takto:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B:$E" Then
MsgBox "Nelze upravovat sloupce C a D"
End If
End Sub
zamknout list...
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.