11. juni 2010 - 13:29Der er
6 kommentarer og 1 løsning
Opslag med flere betingelser over flere ark
Hej
Jeg sidder med følgende problemstilling:
Jeg vil gerne hente data fra en anden fil ud fra følgende kriterier:
1) Selskabsnavn skal den finde i den anden fil i række 2 Nogle af cellerne er merged/sammenflettet Den skal lede efter selskabsnavnet over flere ark.
2) Når den kan finde selskabsnavnet, skal den lede efter datoen. Dato skal den finde i den finde i række 6
Når begge kriterier er opfyldt, skal den hente tallet ud fra, hvad der står i celle A8 (skal være variabel)
Eksempel: Fil 1 Celle C2:H2 Selskabsnavn (er merged) Celle C6 Dato 31-03-2010 Celle A8 Turnover
Fil 2 Celle C2:H2 Selskabsnavn (er merged) Celle C6 Dato 31-03-2010 Celle A8 Turnover Celle C8: 1000
Jeg ønsker, at den i Fil 1 skal hente 1000 i celle C8 fra fil 2 ud fra følgende kriterier: fil 1 Selskabsnavn kan findes i række 2 i fil 2 og fil 1 Dato kan findes i række 6 i fil 2 og Turnover kan findes i kolonne A i fil 2.
REM hvis du sender en mail - returnerer jeg min model. rem @-adresse under profil.
Const sysArkNavn = "system" Const sAdr = "C2" 'selskabsnavn Const dAdr = "C6" 'dato Const tAdr = "A8" 'tekst, der skal søges Const rAdr = "C8" 'søgeresultat Dim sysArk As Worksheet Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set sysArk = ActiveWorkbook.Sheets(sysArkNavn)
If Target.Address = "$A$10" Then If Range(sAdr) <> "" And IsDate(Range(dAdr)) = True And Range(tAdr) <> "" Then Range(rAdr) = "der søges..."
udførSøgning End If End If End Sub Private Sub udførSøgning() Dim sh As Worksheet, selskab As String, dato As Date, sRæk As Long
For Each sh In ActiveWorkbook.Sheets If sh.Name <> sysArkNavn Then selskab = LCase(sh.Range(sAdr)) dato = sh.Range(dAdr)
If sysArk.Range(sAdr) = selskab Then If sysArk.Range(dAdr) = dato Then sRæk = findRække(sh, sysArk.Range(tAdr)) If sRæk > 0 Then sysArk.Range(tAdr).Offset(0, 2) = sh.Cells(sRæk, 3) sysArk.Range(rAdr).Select
Exit Sub End If End If End If End If Next sh End Sub Private Function findRække(sh, søgeOrd) With sh.Range("A:A") Set c = .Find(søgeOrd, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then findRække = c.Row Else findRække = 0 End If End With Exit Function End Function
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
