Sök värden och uppdatera


Här demonstreras en teknik för att söka efter värden inom ett begränsat cellområde. Det kan komma till nytta i en rad olika situationer, inte minst när vi ska uppdatera större listor.

Lösningen kan utvecklas så att vi hämtar uppslagsvärden från ett blad och söker igenom ett cellområde i ett annat blad. Som vanligt är det vår fantasi (och våra behov) som sätter gränsen för tillämpningsområdena.

Ett cellområde kan också omfatta flera områden i flera arbetsblad. Den tekniska lösningen blir därmed mer flexibel än t ex användandet av LETAUPP-funktioner.

Exemplet visar hur vi kan genomsöka och uppdatera flera arbetsblad i den aktiva arbetsboken.

För att välja flera arbetsblad håll ned Ctrl-tangenten och klicka på de önskade arbetsbladen.

 

Option Explicit

 

Sub Sok_Hitta_Uppdatera()

  '© 2002 - 2005 Alla rättigheter XL-Dennis

  Dim wsSheet As Worksheet

  Dim rnArea As Range, rnValue As Range

  Dim stAddress As String

  Dim vaVarde As Variant

 

  Const stTitle As String = "Sök, hitta och uppdatera"

 

  'Hämtar in kodnamn som uppdatering ska ske för

  vaVarde = Application.InputBox("Ange önskad kod för uppdatering:", _

                  Title:=stTitle, Type:=2)

 

  'Om användaren avbryter inmatningen.

  If vaVarde = False Then Exit Sub

 

  Application.ScreenUpdating = False

 

  'Här loopar vi igenom de valda arbetsbladen.

  For Each wsSheet In ActiveWindow.SelectedSheets

    With wsSheet

      'Här bestämmer vi cellområdet som ska utsökas i varje blad.

      Set rnArea = .Range(.Range("A1"), .Range("A65536").End(xlUp))

    End With

 

    'Sökning sker inom det avgränsade cellområdet.

    With rnArea

      Set rnValue = .Find(What:=vaVarde)

      If Not rnValue Is Nothing Then

        stAddress = rnValue.Address

        'Här initieras loppen för att hitta celler med det sökta värdet.

        Do

          With rnValue

            .Offset(0, 1).Value = "XL-Dennis"

            .Offset(0, 2).Value = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hh:mm")

          End With

          Set rnValue = .FindNext(rnValue)

        Loop While Not rnValue Is Nothing And rnValue.Address <> stAddress

      End If

    End With

  Next wsSheet

 

  'Ta bort gruppredigeringsläget.

  ActiveSheet.Select

 

  Application.ScreenUpdating = True

End Sub