< návrat zpět

Obecná diskuse

Téma: Makro - podmínka hledání rss

Zaslal/a jirka9999 11.7.2012 23:35

Dobrý den,chtěla bych poprosit o radu někoho zkušeného, zda by poradil s problémem. Jedná se o to, že bych potřebovala udělat makro, které má dělat následující akce: v sešitu mám celkem tři listy (list1, list2, list3).Na listu1 mám všechny data ve třech sloupcích, kdy ve sloupci A je hodnota E,F,G v rozevíracím seznamu. Každý sloupec má rozevírací seznam. Sloupec B má hodnoty 1 až 9 v rozevíracím seznamu.Sloupec C má hodnoty v rozevíracím seznamu Q,W, R, T.
Potřebuji udělat makro, když ve sloupci A se objeví písmeno E, tak aby se v rolovacím seznamu ve sloupci B objevily jenom hodnoty 1,2,3 a zaroveň ve slouci C hodnota Q,W v rozvíracím seznamu.
Podobně, když ve slouci A bude hodnota F, tak aby se v rozevíracím seznamu ve sloupci B objevily pouze hodnoty 7,8,9 a zaroveň ve slouci C v rozevíracím seznamu hodnoty W,R,T.

Zaslat odpověď >
Jeza, (12.7.2012 14:53)#008999
avatar
Hodil by se příklad.
E=1,2,3 / Q,W
F=7,8,9 / W,R,T
G=?

Jinak myslím, že něco podobného už tady párkrát bylo.
M@
jirka9999, (12.7.2012 22:55)#009002
avatar
Taky si to myslím,jen nic nemohu k tomu najít´. Potřebuji to udělat jako spouštěcí makro nebo alespoň jako funkci, jsem v koncích a nic mě nejde,poradí me někdo? Děkuji.
1
Jeza, (13.7.2012 9:01)#009004
avatar
Třeba pomůže :-)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
Dim podminka1, podminka2 As String
Select Case Target.Value
Case Is = "E"
podminka1 = "1,2,3"
podminka2 = "Q,W"
Case Is = "F"
podminka1 = "7,8,9"
podminka2 = "W,R,T"
Case Is = "G"
podminka1 = "4,5,6"
podminka2 = "R,T"
End Select

If podminka1 <> "" Then
With Range("B" & Target.Row).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=podminka1
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If

If podminka2 <> "" Then
With Range("C" & Target.Row).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=podminka2
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
End Sub
M@
stanhericon, (13.7.2012 10:01)#009008
avatar
Nebo třeba takto. V mem připadě při změně nebo přidani nových údaju pro rozeviraci seznamy neni nutne upravovat kod. Jedna připominka, je to vytvořeno pro excel 2010, pokud by to mělo pracovat v excel 2003, tak by se musel upravit vzorec pro pojmenovanou oblast.
Příloha: file9008_Podminka hledani.zip

Uživatelské menu

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

Menu

On-line nástroje

Novinky

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Insert to SQL

Palooo • 20.6. 8:23

proměnná v makru

eLCHa • 20.6. 8:08

proměnná v makru

marjankaj • 20.6. 7:42

proměnná v makru

eLCHa • 20.6. 7:18

vrateny vysledok

eLCHa • 20.6. 6:57

vrateny vysledok

Opičák • 20.6. 0:45

vrateny vysledok

Opičák • 20.6. 0:14