Excel - vyhledavani na zaklade vice vstupu

[mirakos]

Zdravim,

potreboval bych poradit, mam dva sesity nasledujiciho formatu

Sesit1
Datum, Var. symbol, neco, neco

Sesit2
Neco, neco, Datum, Var. symbol, neco, neco

A potrebuji do Sesitu1 dotahnout hodnotu z sloupce x ze Sesitu2, samozrejme pro dany datum a variabilni symbol ze sesitu 1.

Pres s vyhledat to nepujde, tam lze hledat jen jednu hodnotu.
Diky za pomoc
Mira

[navstevnik]

nize je procedura VBA ( v nejnutnejsim rozsahu, muzes doplnit o odstraneni promennych z pameti,..), zadej cestu a soubor ve kterem je vyhledavano, uprav pripadne adresy sloupcu s VS a zadej ofsety doplnovaneho sloupce pro oba sesity

Kód: Vybrat vše

Option Explicit

Sub VyhledatDoplnit()
  Dim Wbk2 As Workbook, Wsht2 As Worksheet, VarS2 As Range, VCll2 As Range, firstAddress As String
  Dim VarS1 As Range, VCll1 As Range
  '
  With ActiveSheet ' aktivni list v doplnovanem sesitu
    Set VarS1 = .Range(.Range("B2"), .Range("B2").End(xlDown))  ' blok bunek s var symbolem
  End With
  'otevrit sesit 2
  On Error GoTo Err1
  Set Wbk2 = Workbooks.Open("Disk:\cesta\soubor.xls")  'cesta soubor
  Set Wsht2 = Wbk2.Worksheets("list1") ' prohledavany list
  With Wsht2
    Set VarS2 = .Range(.Range("D2"), .Range("D2").End(xlDown))  ' blok bunek s var symbolem
  End With
  ' vyhledat v sesitu 2 a doplnit do sesitu 1
  For Each VCll1 In VarS1.Cells
    With VarS2
      ' vyhledat v sesitu 2
      Set VCll2 = .Find(VCll1, LookIn:=xlValues, LookAt:=xlWhole)
      If Not VCll2 Is Nothing Then ' nalezen VS
        firstAddress = VCll2.Address
        Do
          If VCll2.Offset(0, -1).Value = VCll1.Offset(0, -1).Value Then  ' shoda data
            ' doplnit do sesitu 1
            VCll1.Offset(0, 4).Value = VCll2.Offset(0, 8).Value  ' ofsety sloupcu zadat dle pozadavku
          End If
          Set VCll2 = .FindNext(VCll2)
        Loop While Not VCll2 Is Nothing And VCll2.Address <> firstAddress
      End If
    End With
  Next VCll1
  Wbk2.Close
  Exit Sub
Err1:
  MsgBox "Chybna cesta nebo nazev souboru."
End Sub

[mirakos]

Diky, to je presne ono
Jen jsem to poupravil at je to v ramci jednoho Workbooku

Jeste jednou DIK

[mike007]

mirakos: Příště prosím označ vlákno za vyřešené. Dnes jsem to udělal za tebe...

[JarZa]

jde to i pomocí maticových vzorců, viz příklad v příloze