Avatar billede quqdk Praktikant
27. marts 2014 - 13:11 Der er 4 kommentarer og
1 løsning

(Måske) import af data

Jeg har et regneark med 2 sheets på.

Et rådata-sheet (RDS) og et hoved-sheet (MAIN).

På RDS har jeg en liste med varenavne og links til nogle dokumenter der hører til det pågældende varenavn.

På MAIN har jeg en dropdown liste, hvor meningen er at jeg kan vælge et varenavn, trykke søg, og så vil en macro/vba/noget, lede i RDS på det pågældende varenavn, om der er links eller ej, og i såfald liste linksne op i MAIN under dropdownlisten.
Hvis der derimod ikke er noget data at hente, skal den bare sige "ingen data".

Jeg har prøvet at rode rundt med det, men kan simpelthen ikke få den til noget som helst.

Er der nogen der kan give mig en hjælpende hånd her?
Avatar billede supertekst Ekspert
27. marts 2014 - 13:19 #1
Ja - hvis du kan sende en kopi af filen /model.
@-adresse under min profil.
Avatar billede supertekst Ekspert
27. marts 2014 - 15:44 #2
Indsat under arket MAIN
Const fraRDSkol = "C"
Const tilRDSkol = "Q"

Public vareNavn As String

Dim kol As String, cc, vnr1 As String
Private Sub Worksheet_Activate()
    vnr1 = ""
   
    With ComboBox1
        .Clear

Rem Indsæt VareNavne fra RDS
        For Each cc In Sheets("RDS").Range(fraRDSkol & "1" & ":" & tilRDSkol & "1").Cells
            vareNavn = cc.Text
            .AddItem vareNavn
           
            If vnr1 = "" Then
                vnr1 = cc
            End If
        Next cc
       
        .Text = vnr1
    End With
End Sub
Public Function hentFraRDSKol()
    hentFraRDSKol = fraRDSkol
End Function
Public Function hentTilRDSKol()
    hentTilRDSKol = tilRDSkol
End Function

Indsat under Module1
Const infoRækStart = 6
Dim ræk As Integer, vNavn As String
Dim cc, fra As String, til As String
Dim antalRæk As Integer
Sub Button7_Click()
    sletTidligereInfo

    vNavn = Sheets("main").ComboBox1
    fra = Sheets("MAIN").hentFraRDSKol
    til = Sheets("MAIN").hentTilRDSKol
   
    For Each cc In Sheets("RDS").Range(fra & "1" & ":" & til & "1").Cells
        If cc = vNavn Then
            søgKryds cc
            Exit Sub
        End If
    Next cc
   
    ingenData
End Sub
Private Sub søgKryds(cc)
Dim ræk As Integer, kol As Integer, infoRæk As Integer
    kol = cc.Column
    infoRæk = infoRækStart
   
    For ræk = 2 To 32000
        If Sheets("RDS").Range("B" & ræk) <> "" Then
            If Sheets("RDS").Cells(ræk, kol) = "x" Then
                Sheets("RDS").Range("B" & ræk).Copy
                Sheets("MAIN").Range("C" & infoRæk).Select
                Sheets("MAIN").Paste
                Application.CutCopyMode = False
               
                infoRæk = infoRæk + 1
            End If
        Else
            Exit For
        End If
    Next ræk
   
    If infoRæk = infoRækStart Then
        ingenData
    End If
End Sub
Private Sub ingenData()
    Sheets("MAIN").Range("C6") = "ingen data"
End Sub
Private Sub sletTidligereInfo()
Dim ræk As Integer
    For ræk = infoRækStart To 32000
        If Range("C" & ræk) <> "" Then
            Range("C" & ræk).ClearContents
        Else
            Exit Sub
        End If
    Next ræk
End Sub
Avatar billede supertekst Ekspert
28. marts 2014 - 13:03 #3
Der er lagt et svar på version 1
Avatar billede quqdk Praktikant
28. marts 2014 - 13:12 #4
Tak for hjælpen :D
Avatar billede supertekst Ekspert
28. marts 2014 - 13:20 #5
Selv tak..
Avatar billede Ny bruger Nybegynder

Din løsning...

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester