Avatar billede HHA Forsker
23. oktober 2021 - 11:27 Der er 5 kommentarer og
1 løsning

Problem med VBA kode

Hejsa,

Jeg har et problem med nedenstående kode.
Den overfører fint som den skal, men så snart den møder et felt med "TEKST" så går det galt med overførslen.
For mig ligner det at den ikke kommer op øverst i koden igen og kigger efter celler med "JA".
Den kludrer noget i det.

Koden skal overføre tekst fra celle D, hvis der er et JA eller TEKST i celle B.
Værdi fra enten celle Q eller R alt efter om der er et JA eller NEJ i celle M og ingen værdi overhovedet, hvis der står TEKST i celle B.

Er der nogen der kan se hvad der er galt med koden?

8Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, n As Long, i As Long, b As Long, Lastrow As Long
   
   
    Set ws1 = Sheets("Kalk")
    Set ws2 = Sheets("Tilbud dansk")
   
    Worksheets("Tilbud dansk").Unprotect
    ws2.Range("A105:A" & Rows.Count).ClearContents
    ws2.Range("B105:B" & Rows.Count).ClearContents
    ws2.Range("C105:C" & Rows.Count).ClearContents
    ws2.Range("D105:D" & Rows.Count).ClearContents
    ws2.Cells.Borders.LineStyle = xlLineStyleNone
   
    LR1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
    ActiveSheet.Unprotect
   
    Application.ScreenUpdating = False
   
    LR2 = 105
   
    For i = 10 To LR1
   
   
       
        If ws1.Range("B" & i).Value = "JA" Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 12
            ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 12
            ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "C").Value = ws1.Cells(i, "R").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 12
            ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "D").Value = ws1.Cells(i, "Q").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 12
            ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
           
        LR2 = LR2 + 1
       
        'End If
       
        ElseIf ws1.Range("B" & i).Value = ("TEKST") And ws1.Range("M" & i).Value = ("JA") Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 12
            ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 12
            ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "C").Value = Clear 'ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 12
            ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
            ws2.Cells(LR2, "D").Value = Clear 'ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 12
            ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
   
            LR2 = LR2 + 1
       
        End If
       
    Next i

Application.ScreenUpdating = True
       
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("Tilbud dansk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("Kalk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True

   
End Sub
Avatar billede claes57 Ekspert
23. oktober 2021 - 12:22 #1
test lige med at flytte
LR2 = 105
ned til lige efter
For i = 10 To LR1

og så flytte de to linjer med
LR2 = LR2 + 1
ned til en linje lige før
    Next i
Avatar billede ebea Ekspert
23. oktober 2021 - 13:50 #2
Er det ikke den fuldstændig samme kode, du har i dit andet spørgsmål:

https://www.computerworld.dk/eksperten/spm/1038101

Bortset fra, at i den kode, har du et Ark mere med.

Så hvad er overordnet, egentlig problemet? Ud fra din kode, og beskrivelse i dit seneste spørgsmål, kan jeg ikke se andet, end at den overfører linjer, og når den ser ordet "TEKST" hopper den videre til næste linje hvor ordet "JA" findes.
Avatar billede store-morten Ekspert
23. oktober 2021 - 14:12 #3
ElseIf ws1.Range("B" & i).Value = ("TEKST") And ws1.Range("M" & i).Value = ("JA") Then

Prøv at fjerne ( ) om TEKST og JA
Avatar billede HHA Forsker
23. oktober 2021 - 17:26 #4
claes75,

Det hjalp at flytte
LR2 = LR2 + 1
ned til en linje lige før
    Next i

Der gik ged i den, hvis den første ændring blev lavet også.
Takker 👍
Avatar billede HHA Forsker
23. oktober 2021 - 17:28 #5
store-morten,

Det med at fjerne parenteser hjalp ikke noget.
Har afprøvet dit forslag 👍
Avatar billede HHA Forsker
23. oktober 2021 - 17:34 #6
ebea,

Jo, men det var et andet spørgsmål, hvor spørgsmålet i dette opslag heller ikke virkede.
Men spørgsmålet i denne tråd er nu løst ved at flytte, LR2 = LR2 + 1 ned til en linje lige før Next i, som claes57 foreslog.

Jeg var af den opfattelse, at det er bedre at kun have et spørgsmål i en tråd.

Men er der en der kan hjælpe med spørgsmålet fra den anden tråd, for den har jeg heller ikke gaverne til at løse?
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

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