kunne se udvalgte varenumre i en lang liste

Hvilke data er der pr. varenr?

Prøv denne makro. Varenr. står i A2:A14 tilret selv. Den kopiere dine varenr. til kol. X så den skal også tilrettes hvis du har data her



Sub sorter()
Dim RW(), I, J

MyArr = Range("A2:A14")
søgenr = Split(InputBox("Indtast Søgenumre adskilt af komma"), ",")
Range("X2:X14") = MyArr
Rows.Hidden = False

For nr = 0 To UBound(søgenr)
For I = 1 To UBound(MyArr)
    If MyArr(I, 1) Like "*" & søgenr(nr) & "*" Then
        ReDim Preserve RW(J)
        RW(J) = I + 1
        J = J + 1
    End If
Next I
Next nr

For I = 0 To UBound(RW)
    Range("X" & RW(I)).Value = ""
Next I

Range("X2:X14").Rows.Hidden = True
Range("X2:X14").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False

End Sub

En lille rettelse som fanger hvis søgning ikke giver resultat
Du kan også indtaste en del af et varenr og så findes alle varenumre som indeholder det.


Sub sorter()
Dim RW(), I, J

Rows.Hidden = False
MyArr = Range("A2:A14")
søgenr = Split(InputBox("Indtast Søgenumre adskilt af komma"), ",")
Range("X2:X14") = MyArr

For nr = 0 To UBound(søgenr)
For I = 1 To UBound(MyArr)
    If MyArr(I, 1) Like "*" & søgenr(nr) & "*" Then
        ReDim Preserve RW(J)
        RW(J) = I + 1
        J = J + 1
    End If
Next I
Next nr

If J = 0 Then
    MsgBox "Søgning gav intet resultat"
    Exit Sub
End If

For I = 0 To UBound(RW)
    Range("X" & RW(I)).Value = ""
Next I

Range("X2:X14").Rows.Hidden = True
Range("X2:X14").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False

End Sub

Hvorledes kommer man så tilbage til at se alle varenumre igen?
Der skal siges at regnearket er skrivebeskyttet. Ret vigtig detalje - giver det problemer.

LN

der er varenumre fra a4 til A1300 og der er nok 30-40 kollonner tilknyttet. Dns man skal noget længer ud end x, men det finder jeg ud at korrigere for.

LN

Har tilrettet koden så det passer med dine områder og så det virker på det beskyttede ark.


Sub sorter()
Dim RW(), I, J

ActiveSheet.Unprotect
Rows.Hidden = False
K = Range("A65536").End(xlUp).Row
MyArr = Range("A4:A" & K)
Range("IV4:IV" & K) = MyArr
søgenr = Split(InputBox("Indtast Søgenumre adskilt af komma"), ",")

For nr = 0 To UBound(søgenr)
For I = 1 To UBound(MyArr)
    If MyArr(I, 1) Like "*" & søgenr(nr) & "*" Then
        ReDim Preserve RW(J)
        RW(J) = I + 3
        J = J + 1
    End If
Next I
Next nr

If J = 0 Then
    MsgBox "Søgning gav intet resultat"
    Exit Sub
End If

For I = 0 To UBound(RW)
    Range("IV" & RW(I)).Value = ""
Next I

Rows("4:" & K).Hidden = True
Range("IV4:IV" & K).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
ActiveSheet.Protect

End Sub


mht. at se varenumrene kan du køre makroen og trykke cansel til inputboksen eller køre en ny makro:

Sub VisIgen()
ActiveSheet.Unprotect
Rows.Hidden = False
ActiveSheet.Protect
End Sub

det fungerer bare perfekt

Tak.
Læg et svar

LN

Super. Du får et svar