< návrat zpět
MS Excel
Téma: ověření dat - seznam z výce zdrojů ![rss](./plugins/templates/wall_2C/images/icons/rss.png)
Zaslal/a Mell 26.6.2017 13:43
Ahoj pánové,
nejspíš to bude úplná banalita, která mi zkrátka nedochází nebo to seznam neumožnuje. Jde do seznamu v ověření dat zahrnout data z více zdrojů (listů). Resp. pokračovat při vybírání dat na dalším listě. viz. vzor, děkuji za pomoc a nezlobte se, že otravuji s takovou prkotinou.
Příloha:
36734_vzor.xlsx (11kB, staženo 30x)
elninoslov(26.6.2017 14:30)#036735 ![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
To nepôjde, musíte si urobiť zlučovaciu tabuľku...
citovat
Mell(26.6.2017 15:28)#036736 ![avatar](./pictures/avatars/no-avatar.jpg)
pomocná tabulka pokulhává, protože se data ve zdroji 1 a 2 budou dynamicky měnit podle příbytků a úbytků. Resp. by to možná šlo, ale už by to nebyla jednoduchá pomocná tabulka.
citovat
elninoslov(26.6.2017 17:30)#036737 ![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
Napr. vzorec na 1000 riadkov.
Příloha:
36737_36734_vzor.xlsx (35kB, staženo 34x) citovat
MePExG(26.6.2017 21:01)#036738 ![MePExG](./pictures/avatars/5dc673c1a045f.jpg)
Pridávam zoznam (Spoj) aktualizovaný pomocou Power Query ([aktualizovaný pri otvorení a každé 3 minúty] použiteľné od verzie 2010-doplnok, 2016-obsahuje).
Příloha:
36738_pq-vzor.xlsx (33kB, staženo 30x) citovat
nunus67(27.6.2017 3:18)#036739 ![avatar](./pictures/avatars/no-avatar.jpg)
Pridavam reseni makrem:
Option Explicit
Function LastUsedRow(ws As Worksheet, column As Long) As Long
LastUsedRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
End Function
Sub SetValidation()
Dim RngSource As Range, rDV As Range, r As Range, csString As String, v As String
Dim c As Collection
Dim sDV As Worksheet, sH As Worksheet
Set sDV = ThisWorkbook.Sheets("výstup")
Set rDV = sDV.Range("A2:A50")
csString = ""
Set c = New Collection
'set zdroj1
Set sH = ThisWorkbook.Sheets("zdroj1")
Set RngSource = sH.Range("A2:A" & LastUsedRow(sH, 1))
On Error Resume Next
For Each r In RngSource
v = r.Value
If v <> "" Then
c.Add v, CStr(v)
If Err.Number = 0 Then
If csString = "" Then
csString = v
Else
csString = csString & "," & v
End If
Else
Err.Number = 0
End If
End If
Next r
On Error GoTo 0
'set zdroj2
Set sH = ThisWorkbook.Sheets("zdroj2")
Set RngSource = sH.Range("A2:A" & LastUsedRow(sH, 1))
On Error Resume Next
For Each r In RngSource
v = r.Value
If v <> "" Then
c.Add v, CStr(v)
If Err.Number = 0 Then
If csString = "" Then
csString = v
Else
csString = csString & "," & v
End If
Else
Err.Number = 0
End If
End If
Next r
On Error GoTo 0
'MsgBox csString
With rDV.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=csString
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
Set sH = Nothing
Set sDV = Nothing
Set RngSource = Nothing
Set rDV = Nothing
End Subcitovat
Mell(27.6.2017 9:50)#036740 ![avatar](./pictures/avatars/no-avatar.jpg)
Mockrát pánové děkuji, že jste mi věnovali trocha prostoru. Během dne otestuji a dám vědět :) Ještě jednou děkuji!!!
citovat