Långsam sökning

[Axi]

Jag skrev ihop detta men det går förfärligt långsamt. Jag gissar att den gör det för att den letar efter alla cellers värde inom rangen, även tomma cellers värde. Finns det något bra knep för att den ska kolla om cellen har värde innan den börjar leta?

 

 

Public LastCol As Integer
Public refRange As Range
Public refClear As Range


Sub findandcopy()

Dim artNO As Range
Dim valNO As Range
Dim targRange As Range
Dim fCell As Range
Dim lcell As Range



'Sätter ut sista cellen och ställer in ID'

With Worksheets("bas")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Worksheets("sedel").Cells(2, 4) = Worksheets("bas").Cells(1, 4).Value
Worksheets("bas").Cells(1, LastCol + 1) = Worksheets("sedel").Cells(2, 4)




'Letar upp varje artikelnummer i "bas" och klistrar in antal från "sedel"'
Set artNO = Worksheets("sedel").Cells(5, 1)
Set valNO = Worksheets("sedel").Cells(5, 1).Offset(0, 2)

With Worksheets("sedel")
Set refRange = Range("A5", Range("A65536").End(xlUp))
Set refClear = Range("A5", Range("D65536").End(xlUp))
End With

With Worksheets("bas")
Set targRange = Range("A2", Range("A65536").End(xlUp))
End With

For Each lcell In refRange
   With targRange
     Set fCell = Worksheets("baS").Columns(1).Find(What:=artNO, After:=.Cells(2, 1), LookIn:=xlValues, LookAt:= _
         xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False)
     On Error GoTo 0

     If Not fCell Is Nothing Then fCell.Offset(0, LastCol) = valNO

    Set artNO = artNO.Offset(1, 0)
    Set valNO = valNO.Offset(1, 0)

   End With


Next lcell
End Sub

[Mr Andersson]

Jag skrev ihop detta men det går förfärligt långsamt. Jag gissar att den gör det för att den letar efter alla cellers värde inom rangen, även tomma cellers värde. Finns det något bra knep för att den ska kolla om cellen har värde innan den börjar leta?

 

 

Public LastCol As Integer
Public refRange As Range
Public refClear As Range


Sub findandcopy()

Dim artNO As Range
Dim valNO As Range
Dim targRange As Range
Dim fCell As Range
Dim lcell As Range



'Sätter ut sista cellen och ställer in ID'

With Worksheets("bas")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Worksheets("sedel").Cells(2, 4) = Worksheets("bas").Cells(1, 4).Value
Worksheets("bas").Cells(1, LastCol + 1) = Worksheets("sedel").Cells(2, 4)




'Letar upp varje artikelnummer i "bas" och klistrar in antal från "sedel"'
Set artNO = Worksheets("sedel").Cells(5, 1)
Set valNO = Worksheets("sedel").Cells(5, 1).Offset(0, 2)

With Worksheets("sedel")
Set refRange = Range("A5", Range("A65536").End(xlUp))
Set refClear = Range("A5", Range("D65536").End(xlUp))
End With

With Worksheets("bas")
Set targRange = Range("A2", Range("A65536").End(xlUp))
End With

For Each lcell In refRange
   With targRange
     Set fCell = Worksheets("baS").Columns(1).Find(What:=artNO, After:=.Cells(2, 1), LookIn:=xlValues, LookAt:= _
         xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False)
     On Error GoTo 0

     If Not fCell Is Nothing Then fCell.Offset(0, LastCol) = valNO

    Set artNO = artNO.Offset(1, 0)
    Set valNO = valNO.Offset(1, 0)

   End With


Next lcell
End Sub

 

 

Börja med att kontorllera att refRange och targRange verkligen är det du tänkt dig.

 

msgbox refRange.address

msgbox targRange.address

[Monshi]

Du använder With-kod men på fel sätt

För att referera till bladet du har i With-koden måste en punkt vara första bokstaven i referensen. Dvs

With Blad1
.Range(....)
End With

 

utan punkten refererar den, beroende på var koden står, till bladet koden står på eller till aktiva bladet.

 

dvs dina referenser till refRange, refClear och targRange är troligen felaktiga.

 

Du har även On Error Goto mitt i en For Each? varför där?

 

Allmänt knep för att snabba upp vid skrivning till blad är att lägga till

Application.ScreenUpdating = False

innan man skriver till ett blad.

 

Ed:

Samt vad söker du efter? Du stegar med lcell men du använder inte lcell inom stegningen?

Que?

[Axi]

Hmm.. Så det är därför den tappade bladreferensen. Ok, jag försökte med .range i början, men fick bara felmeddelande. Jag visste dock inte att With inte fungerade om man tog bort . i början.

 

Märkligt nog verkar alla referenser till range stämma. Jag hade fel på en i slutet, men det låste jag med worksheet.

 

--------------

On Error Goto är en rest av en lånad kodbit. Jag har inte haft en tanke på att jag glömt kvar den.

 

-------------------

Application.ScreenUpdating = False

Detta knep känner jag till. Mycket bra, fast det är så små snabba kopieringar jag gör och tack vare din hjälp tidigare använder jag inte .select längre.. Så sceenupdating i all ära, men den har minimal påvekan här tror jag. (Lägger till ändå)

 

---------------

Tja, stegningen är typ den enda metod jag fått att fungera.

Jag försökte först med do while, men fick inte rätt på det.

Jag söker ju efter värdet artNO som ändras till nästa cell (nedåt) vid varje cykel, det är detta jag tror drar ut på tiden eftersom den då även söker efter tomma cellers värde och i pricip kopierar en tom cell från en tom cell till en anna tom cell.. hrm..

[Monshi]

För att ta bort tomma celler, lägg till en koll i loopen:

if artNO<> "" then
Set fCell = 

så hoppas den över.

 

 

[Axi]

Lite galet men koden uppförs sig lite udda.

Jag har tack vare Monshi's tips fått ner söktiden enormt, men jag får ett annat lite udda problem på halsen.

 

Först den reviderade koden:

 

Public LastCol As Integer
Public refRange As Range
Public targRange As Range

Sub findandcopy()

Dim artNO As Range
Dim valNO As Range
Dim fCell As Range
Dim lcell As Range

'Sätter ut sista cellen och ställer in ID'
   With Worksheets("bas")
       LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
   End With

Worksheets("sedel").Cells(1, 4) = Worksheets("bas").Cells(1, 4).Value
Worksheets("bas").Cells(1, LastCol + 1) = Worksheets("sedel").Cells(1, 4)

'Letar upp varje artikelnummer i "bas" och klistrar in antal från "sedel"'
Set artNO = Worksheets("sedel").Cells(4, 1)
Set valNO = artNO.Offset(0, 2)
Set refRange = Worksheets("sedel").Range("A4", Range("A65536").End(xlUp))
'Set targRange = Worksheets("bas").Range("A2",' Range("A65536").End(xlUp))
Set targRange = Worksheets("bas").Range("A1:A1000")

For Each cell In refRange

   If artNO.Value <> "" Then
       Set fCell = targRange.Find(What:=artNO, After:=Cells(1, 1), LookIn:=xlValues, LookAt:= _
       xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       , SearchFormat:=False)
   End If

   If Not fCell Is Nothing Then fCell.Offset(0, LastCol) = valNO
       Set artNO = artNO.Offset(1, 0)
       Set valNO = artNO.Offset(0, 2)

Next cell

End Sub

 

När jag lägger till IF satsen som Monshi tipsade om så händer detta:

 

OM där är en blank rad i "refRange" så kommer koden INTE att skriva ut värdet från den näst sista träffen.

Den letar efter cellen, och hittar den, den t.o.m. kopierar värdet, men den klistrar aldrig in det.

 

Är det någon som kan se varför bara genom att titta på koden?

 

Edit, en sak till:

 

Set targRange = Worksheets("bas").Range("A2", Range("A65536").End(xlUp))

Denna raden ger mig '400' fel i excel och jag blir inte klok på varför-

[ZebulonM]

fel 400 har jag för mig innebär att koden inte förstår addresseringen. gissning att du får lägga till vilken workbook du vill arbeta med i din adressering. koden funkar kanske bra om du endast har den aktuella excelfilen öppen?

jag brukar ta snabbgenvägen och lägga till något i stil med Worksheets("bas").activate eller select, vilket alltid uppskattas av Monshi

[Monshi]

Problemet med denna rad

Set targRange = Worksheets("bas").Range("A2", Range("A65536").End(xlUp))

 

är att andra anropet till Range inte går till samma blad som den första.

Skriv istället

With Worksheet("bas")
.Range("A2", .Range("A65536").End(xlUp))
End With

 

Notera dock att Excel 2007 har fler rader än 2003, ja, typ, en miljon, så bättre att skriva

With Worksheet("bas")
.Range("A2", .Cells(.Range("A:A").Rows.Count, 1).End(xlUp))
End With

 

till exempel

[Axi]

Hmm..

 

Ja det låter ju logiskt. Jag ska prova.

 

Dock förklarar inte det varför

If artNO.Value <> "" Then

gör att koden hoppar över det näst sista värdet.

[Monshi]

Hmm..

 

Ja det låter ju logiskt. Jag ska prova.

 

Dock förklarar inte det varför

If artNO.Value <> "" Then

gör att koden hoppar över det näst sista värdet.

 

Ha (f'låt), läs och se vad som står i din kod. Med If-satsen skriven där sker ingen sökning och värdet på fcell uppdateras aldrig varvid ArtNo aldrig räknas upp. Tänk om lite så ska du se att du får till det

[Axi]

Mm.. Det var ju det som var lite lustigt ( som jag skrev i inlägg #6 ). Den söker ju faktiskt och både hittar och kopierar, men den klistrar inte in. Och detta gör den när nästa 'artNO' är just "". Inte det den håller på med.

 

Den ska ju faktiskt hoppa över sökningen när artNO = "". Makrot går mycket snabbare nu, men den skippar som sagt det näst sista värdet den hittar istället.

 

Men jag antar att jag får klura på det ett tag som du säger Monshi. Jag har redan fått enormt mycket hjälp av dej här så lite får jag väl göra själv. ^^

[Monshi]

Mm.. Det var ju det som var lite lustigt ( som jag skrev i inlägg #6 ). Den söker ju faktiskt och både hittar och kopierar, men den klistrar inte in. Och detta gör den när nästa 'artNO' är just "". Inte det den håller på med.

 

Den ska ju faktiskt hoppa över sökningen när artNO = "". Makrot går mycket snabbare nu, men den skippar som sagt det näst sista värdet den hittar istället.

 

Men jag antar att jag får klura på det ett tag som du säger Monshi. Jag har redan fått enormt mycket hjälp av dej här så lite får jag väl göra själv. ^^

 

Skapa en kort lista, sätt en brytpunkt och stega dig igenom koden. Då ser du nog ganska snabbt när det blir fel.

fast, oops, jag blev lite lurad av indenteringen i ditt inlägg, sista IF-satsen är bara en rad ser jag nu.

 

Tittar på koden igen, hittar en till referens som jag inte har någon aning om vart den pekar

After:=Cells(1, 1)

i Find-satsten.

och du stegar med cell (olämpligt namn) över alla celler i targetRange men du nyttjar aldrig denna referens.

 

äsch, nu tar jag mig in i koden och ändrar lite och ett sista, mycket viktigt, påpekande

Deklarera ALLTID ALLA variabler!

Ställ in att VBA-editorn ska kräva att variabler deklareras, då läggs raden Option Explicit till högst i varje kodblad.

 

Nåja, lite ändringa

Public LastCol As Integer
Public refRange As Range
Public targRange As Range

Sub findandcopy()
Dim myCell As Range

Dim fCell As Range
Dim lcell As Range

'Sätter ut sista cellen och ställer in ID'
With Worksheets("bas")
	LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Worksheets("sedel").Cells(1, 4) = Worksheets("bas").Cells(1, 4).Value
Worksheets("bas").Cells(1, LastCol + 1) = Worksheets("sedel").Cells(1, 4)

'Letar upp varje artikelnummer i "bas" och klistrar in antal från "sedel"'
With Worksheets("sedel")
Set refRange = .Range("A4", .Range("A65536").End(xlUp))
End With

'Set targRange = Worksheets("bas").Range("A2",' Range("A65536").End(xlUp))
Set targRange = Worksheets("bas").Range("A1:A1000")
For Each myCell In refRange
If myCell <> "" Then
	Set fCell = targRange.Find(What:=myCell, LookIn:=xlValues, LookAt:= _
	xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
	, SearchFormat:=False)
End If

If Not fCell Is Nothing Then fCell.Offset(0, LastCol) = myCell.Offset(0, 2)

Next myCell

End Sub

 

Obs, jag har inte testkört koden...

[Axi]

Den funkar bra Monshi, men resultatmässigt skiljer den sig inte från min gamla kod.

Samma problem kvarstår. Om den hittar en tom cell i "mitten" på listan så kommer den att hoppa över att klistra in näst sista värdet.

 

Jag funderar på att lägga upp hela Exceldokumentet så att du kan se vad jag pratar om. ^^

 

Jag har använd Ozgrids exempel på Find metod och det är från detta exempel som "cells(1,1)" kommer från:

 

Note the use of .Cells(1,1) as the After:= setting. If this was ANY cell NOT within Column A the code would normally bug-out. However, the use of On Error Resume Next prevents this. BUT, despite that you will not be taken to the cell. Sheet1 is the Worksheets CodeName

 

The After setting is also very important. Whichever cell is set here will be the last one searched and not the first as some may expect. For this reason, one should always set this explicitly each and every time you use the Find Method.

[Monshi]

after-settingen spelar normalt sett ingen roll, som MS skriver det

The cell after which you want the search to begin. This corresponds to the position of the active cell when a search is done from the user interface. Note that After must be a single cell in the range. Remember that the search begins after this cell; the specified cell isn’t searched until the method wraps back around to this cell. If you don’t specify this argument, the search starts after the cell in the upper-left corner of the range.

och i ditt fall, när du skriver

 

after:=Cells(1,1) är du utanför området du söker i.

 

Men till felet, nu ser jag det... lägg till raden

Set fCell = Nothing

först, eller sist, i loopen.

 

eller lägg in If-satsen som kolla fCell innanför den andra. ja, det är bättre:

 If myCell <> "" Then
Set fCell = targRange.Find(What:=myCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not fCell Is Nothing Then fCell.Offset(0, LastCol) = myCell.Offset(0, 2)

End If

då ska det fungera som du vill

 

[Axi]

Woho! Där satt den!

Tack så mycket Monshi. Den där lilla buggen har retat mig i flera dagar men jag är inte så duktig att jag hittat den ännu.