Problem med formatering ved lopslag - F2 tast

Du er velkommen til at sende den pågældende fil /uddrag.
Mail under profil.

En løsning kunne måske også være via VBA - afh. af konteksten.

Hvis det er din opslagsværdi der er tekst og din tabelmatrix der er tal kan du lave lopslaget til tal ved at sige =lopslag(opslagscelle+0;kilde;kolonnenummer;falsk)

Hvis det er din tabelmatrix der er tekst og din opslagsværdi der er tal er du nødt til at lave en ny kolonne ved siden af din nøglekolonne som hedder opslagscelle+0, kopiere den nye over i den oprindelige og sige indsæt som værdi.

Har udarbejdet en makro:
Oprindelige/p.t. antal LOPSLAG-fejl: 5430

13346 rækker er behandlet
12052 rækkers productId kan findes

Process-tid 35 sek.

Filen returneres & koden vises

Koden:

Dim ark2 As Worksheet, productID As String
Dim pRække As Integer, antalFundne As Integer, res1 As Variant
Public Sub autoLopslag()
Rem definer kildeArk
    Set ark2 = ActiveWorkbook.Sheets("LIIIM2")
    antalFundne = 0
    antalmedfejl = 0
   
    Application.ScreenUpdating = False
   
Rem Traverser ark1
    For ræk = 2 To 65000
Rem hent produktNr fra Kolonne E
        productID = Cells(ræk, 5)
       
        res1 = Cells(ræk, 6)
        If IsError(res1) = True Then
            antalmedfejl = antalmedfejl + 1
        End If
       
        If productID = "" Then
            Exit For
        Else
            pRække = søgProductID(productID)
            If pRække > 0 Then
                antalFundne = antalFundne + 1
               
Rem vises til højre for oprindelige resultat-celler
                ActiveSheet.Range("O" & CStr(ræk)) = hentProductData(pRække, 25)
                ActiveSheet.Range("P" & CStr(ræk)) = hentProductData(pRække, 26)
                ActiveSheet.Range("Q" & CStr(ræk)) = hentProductData(pRække, 27)
                ActiveSheet.Range("R" & CStr(ræk)) = hentProductData(pRække, 2)
            End If
        End If
    Next ræk
   
    Application.ScreenUpdating = True
   
    MsgBox ("Antal beh. række: " & CStr(ræk - 1) & vbCr & _
        "Antal fundne: " & CStr(antalFundne & vbCr & _
            "Antal opr. fejl: " & CStr(antalmedfejl)))
End Sub
Private Function søgProductID(id)
    With ark2.Range("A2:A65000")
        Set c = .Find(id, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            søgProductID = c.Row
        Else
            søgProductID = 0
        End If
    End With
    Exit Function
End Function
Private Function hentProductData(række, kolonneNr)
    hentProductData = ark2.Cells(række, kolonneNr)
End Function

Hej

Smider du et svar, så du kan få dine point?

Tak,
Helene

Det får du her & selv tak