Søg
Avatar billede steensommer Praktikant
01. januar 2004 - 17:16 Der er 24 kommentarer og
1 løsning

Finde nøjagtig match

Hej
Jeg har en VBA der søger et bestemt område udfra et nummer. Nummeret er formateret: 000000. Jeg ville gerne om den KUN returnerede 100% match indenfor det ønskede område: 040001:042000 og ikke andre: ex:400 returnere første ledige celle og det er ikke meningen.
Hvem kan hjælpe? VBA'en er lidt snørklet og kunne sikkert skrives bedre: men hver fugl synger med sit næb ;0)
vh Steen

Sub RegistrerData()
 
Application.ScreenUpdating = False
Dim Nummer As String, twb As Workbook
Set twb = ThisWorkbook
Nummer = twb.Sheets("Data").Range("A3")

With Sheets("Data").Range("A5:A3000")
    Set C = .Find(Nummer, LookIn:=xlValues)
    If Not C Is Nothing Then
            C1 = C.Offset(-4, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C3 = C.Offset(-4, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C4 = C.Offset(-4, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C5 = C.Offset(-4, 5).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C6 = C.Offset(-4, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C7 = C.Offset(-4, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C8 = C.Offset(-4, 8).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C10 = C.Offset(-4, 10).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C11 = C.Offset(-4, 11).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C12 = C.Offset(-4, 12).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C13 = C.Offset(-4, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C14 = C.Offset(-4, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C15 = C.Offset(-4, 15).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C16 = C.Offset(-4, 16).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C17 = C.Offset(-4, 17).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C18 = C.Offset(-4, 18).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C19 = C.Offset(-4, 19).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C20 = C.Offset(-4, 20).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C21 = C.Offset(-4, 21).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C22 = C.Offset(-4, 22).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C23 = C.Offset(-4, 23).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C24 = C.Offset(-4, 24).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C25 = C.Offset(-4, 25).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C26 = C.Offset(-4, 26).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C27 = C.Offset(-4, 27).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C28 = C.Offset(-4, 28).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C29 = C.Offset(-4, 29).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C30 = C.Offset(-4, 30).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C31 = C.Offset(-4, 31).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C32 = C.Offset(-4, 32).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C33 = C.Offset(-4, 33).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C34 = C.Offset(-4, 34).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C35 = C.Offset(-4, 35).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C36 = C.Offset(-4, 36).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C37 = C.Offset(-4, 37).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C38 = C.Offset(-4, 38).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C39 = C.Offset(-4, 39).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C40 = C.Offset(-4, 40).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C41 = C.Offset(-4, 41).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C42 = C.Offset(-4, 42).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C43 = C.Offset(-4, 43).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            C44 = C.Offset(-4, 44).Address(RowAbsolute:=False, ColumnAbsolute:=False)

                .Range(C1).Value = twb.Sheets("Data").Range("B3")
                .Range(C3).Value = twb.Sheets("Data").Range("D3")
                .Range(C4).Value = twb.Sheets("Data").Range("E3")
                .Range(C5).Value = twb.Sheets("Data").Range("F3")
                .Range(C6).Value = twb.Sheets("Data").Range("G3")
                .Range(C7).Value = twb.Sheets("Data").Range("H3")
                .Range(C8).Value = twb.Sheets("Data").Range("I3")
                .Range(C10).Value = twb.Sheets("Data").Range("K3")
                .Range(C11).Value = twb.Sheets("Data").Range("L3")
                .Range(C12).Value = twb.Sheets("Data").Range("M3")
                .Range(C13).Value = twb.Sheets("Data").Range("N3")
                .Range(C14).Value = twb.Sheets("Data").Range("O3")
                .Range(C15).Value = twb.Sheets("Data").Range("P3")
                .Range(C16).Value = twb.Sheets("Data").Range("Q3")
                .Range(C17).Value = twb.Sheets("Data").Range("R3")
                .Range(C18).Value = twb.Sheets("Data").Range("S3")
                .Range(C19).Value = twb.Sheets("Data").Range("T3")
                .Range(C20).Value = twb.Sheets("Data").Range("U3")
                .Range(C21).Value = twb.Sheets("Data").Range("V3")
                .Range(C22).Value = twb.Sheets("Data").Range("W3")
                .Range(C23).Value = twb.Sheets("Data").Range("X3")
                .Range(C24).Value = twb.Sheets("Data").Range("Y3")
                .Range(C25).Value = twb.Sheets("Data").Range("Z3")
                .Range(C26).Value = twb.Sheets("Data").Range("AA3")
                .Range(C27).Value = twb.Sheets("Data").Range("AB3")
                .Range(C28).Value = twb.Sheets("Data").Range("AC3")
                .Range(C29).Value = twb.Sheets("Data").Range("AD3")
                .Range(C30).Value = twb.Sheets("Data").Range("AE3")
                .Range(C31).Value = twb.Sheets("Data").Range("AF3")
                .Range(C32).Value = twb.Sheets("Data").Range("AG3")
                .Range(C33).Value = twb.Sheets("Data").Range("AH3")
                .Range(C34).Value = twb.Sheets("Data").Range("AI3")
                .Range(C35).Value = twb.Sheets("Data").Range("AJ3")
                .Range(C36).Value = twb.Sheets("Data").Range("AK3")
                .Range(C37).Value = twb.Sheets("Data").Range("AL3")
                .Range(C38).Value = twb.Sheets("Data").Range("AM3")
                .Range(C39).Value = twb.Sheets("Data").Range("AN3")
                .Range(C40).Value = twb.Sheets("Data").Range("AO3")
                .Range(C41).Value = twb.Sheets("Data").Range("AP3")
                .Range(C42).Value = twb.Sheets("Data").Range("AQ3")
                .Range(C43).Value = twb.Sheets("Data").Range("AR3")
                .Range(C44).Value = twb.Sheets("Data").Range("AS3")
        Else:
        MsgBox ("Nummeret blev ikke fundet")
        Exit Sub
        End If
End With

Sheets("Data").Range("A3:B3,D3:I3,K3:AS3").ClearContents
ActiveWorkbook.Save

MsgBox ("Registrering foretaget!")

End Sub
Avatar billede kabbak Professor
01. januar 2004 - 18:22 #1
jeg har prøvet at kikke på det, er kogt lidt ned.

Test og skriv, om det er det du mener.

Sub RegistrerData()
Application.ScreenUpdating = False
On Error GoTo Fejl
Dim Nummer As String, twb As Workbook
Set twb = ThisWorkbook
Nummer = twb.Sheets("Data").Range("A3")
C = Application.WorksheetFunction.Match(Nummer, twb.Sheets("Data").Range("A5:A3000"), 0)
      For I = 0 To 43
      If I <> 1 And I <> 8 Then
        Cells(C, 1 + I).Value = twb.Sheets("Data").Cells(3, 1 + I)
      End If
      Next
Sheets("Data").Range("A3:B3,D3:I3,K3:AS3").ClearContents
ActiveWorkbook.Save

MsgBox ("Registrering foretaget!")
Exit Sub
Fejl:
    MsgBox ("Nummeret blev ikke fundet")
End Sub
Avatar billede steensommer Praktikant
01. januar 2004 - 18:34 #2
Hej kabbak - du skal lige bemærke at der oversprunget 2 stk: C2 og C9 der er oversprunget (beregnede data). Jeg prøver lige det du har lavet
Avatar billede kabbak Professor
01. januar 2004 - 18:36 #3
det gør den her

If I <> 1 And I <> 8 Then

læg 1 til tallet så kan du se at det er 2 og 9 den hopper over
Avatar billede steensommer Praktikant
01. januar 2004 - 18:52 #4
Den skriver: Nummeret blev ikke fundet - selvom nummeret var indenfor det ønskede (040002)?
Avatar billede kabbak Professor
01. januar 2004 - 18:57 #5
Den finder kun værdien hvis den findes, skal den finde flere værdier.

Eller skal den finde værdier inden for et bestemt område.
Avatar billede steensommer Praktikant
01. januar 2004 - 19:02 #6
Den skal finde én værdi indenfor området A5:A3000 (der primært er udfyldt som følger: 040001, 040002, 040003 etc)
Avatar billede kabbak Professor
01. januar 2004 - 19:07 #7
OK det gør den også ved mig, mine celler formater står til tekst, hvad gør dine.
Avatar billede kabbak Professor
01. januar 2004 - 19:13 #8
Jeg kan ikke ud fra din kode se hvor den skriver i men det er vel i et andet ark, eller anden mappe.
Avatar billede kabbak Professor
01. januar 2004 - 19:16 #9
Formatet på twb.Sheets("Data").Range("A3"), skal også være det samme som i listen, med alle foran stående nuller.
Avatar billede steensommer Praktikant
01. januar 2004 - 19:17 #10
Den skriver i samme projektmappe, samme ark: Data udfor et i forvejen vedtaget nummer ex: 040010
Avatar billede steensommer Praktikant
01. januar 2004 - 19:21 #11
Den laver noget helt galt - den sletter række 1. Det samme skete i min oprindelige kode inden jeg indsatte offset(-4
Avatar billede kabbak Professor
01. januar 2004 - 19:25 #12
jeg lurer også på dette
  C1 = C.Offset(-4, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)

C.Offset(-4, 1).Address

betyder at den skal finde adressen på en celle der ligger 4 rækker over den celle der er fundet. og 1 kolonne til højre
Avatar billede kabbak Professor
01. januar 2004 - 19:28 #13
da dit søgeområde er  Range("A5:A3000"), vil et C.Offset(-4, 1) pege på celle(B1).
Avatar billede kabbak Professor
01. januar 2004 - 19:28 #14
hvis den fandt værdien i A1
Avatar billede kabbak Professor
01. januar 2004 - 19:29 #15
A5 selvfølgelig
Avatar billede steensommer Praktikant
01. januar 2004 - 19:34 #16
Den oprindelige kode fandt nummeret og udfyldte herefter i SAMME række hvor nummeret var
Avatar billede kabbak Professor
01. januar 2004 - 19:38 #17
så skal den være sådan

Sub RegistrerData()
Application.ScreenUpdating = False
On Error GoTo Fejl
Dim Nummer As String, twb As Workbook
Set twb = ThisWorkbook
Nummer = twb.Sheets("Data").Range("A3")
C = Application.WorksheetFunction.Match(Nummer, twb.Sheets("Data").Range("A5:A3000"), 0)
      For I = 0 To 43
      If I <> 1 And I <> 8 Then
        Cells(C + 4, 1 + I).Value = twb.Sheets("Data").Cells(3, 1 + I)
      End If
      Next
Sheets("Data").Range("A3:B3,D3:I3,K3:AS3").ClearContents
ActiveWorkbook.Save

MsgBox ("Registrering foretaget!")
Exit Sub
Fejl:
    MsgBox ("Nummeret blev ikke fundet")
End Sub


Hvor kommer dataerne fra, dem i række 3.?

virker søgningen nu, den i min kode. ?
Avatar billede steensommer Praktikant
01. januar 2004 - 19:44 #18
Data kommer fra række 3. Der resterer 1 lille fejl idet kolonne B (Cpr) ikke flyttes det gør derimod kolonne C (beregnet alder)
Avatar billede steensommer Praktikant
01. januar 2004 - 19:52 #19
Hvis jeg må ændre noget ville det være ok om den flyttede hele linien uden at springe de 2 kolonner over - det gør det forhåbentlig nemmere :0)
Avatar billede kabbak Professor
01. januar 2004 - 20:00 #20
Sub RegistrerData()
Application.ScreenUpdating = False
On Error GoTo Fejl
Dim Nummer As String, twb As Workbook
Set twb = ThisWorkbook
Nummer = twb.Sheets("Data").Range("A3")
C = Application.WorksheetFunction.Match(Nummer, twb.Sheets("Data").Range("A5:A3000"), 0)
      For I = 0 To 43
      If I <> 1 And I <> 8 Then
        Cells(C + 4, 2 + I).Value = twb.Sheets("Data").Cells(3, 2 + I)
      End If
      Next
'Sheets("Data").Range("A3:B3,D3:I3,K3:AS3").ClearContents
'ActiveWorkbook.Save

MsgBox ("Registrering foretaget!")
Exit Sub
Fejl:
    MsgBox ("Nummeret blev ikke fundet")
End Sub


skulle virke nu, med de 2 overspring
Avatar billede kabbak Professor
01. januar 2004 - 20:03 #21
fjern lige ' erne her

'Sheets("Data").Range("A3:B3,D3:I3,K3:AS3").ClearContents
'ActiveWorkbook.Save
Avatar billede steensommer Praktikant
01. januar 2004 - 20:07 #22
"Skide" godt kabbak - så kører det bare - tusinde tak for hjælpen. Husk at svare :0)
Avatar billede steensommer Praktikant
01. januar 2004 - 20:08 #23
Kan man ikke med FIND kommandoen finde en præcis match?
Avatar billede kabbak Professor
01. januar 2004 - 20:14 #24
Jeg må indrømme at jeg ikke har den store erdaring med FIND og MATCH, men mon ikke de næsten gør det samme
Avatar billede kabbak Professor
01. januar 2004 - 20:14 #25
erdaring = erfaring
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
Kategori
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Ændre tal i en celle Af xvid i Excel 1 04/09/202616:05 04/09/202616:54
Kan Excel selv beregne alder? Af leahcim i Excel 7 31/08/202610:24 04/09/202602:08
problem med mailbesked Af Pestilensen i Excel 3 24/08/202611:16 28/08/202612:55
Sætte billeder ind i google sheets ark ud fra elev nummer Af lurup i Excel 18 17/08/202615:14 05/09/202622:04
Gemme største værdi Af Lemming@privat.dk i Excel 2 07/08/202622:13 08/08/202609:03
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 14:55 Hente WordPad til Windows 11 Af Strawberry i Andet software
I går 11:37 Persits.Upload Af bsn i ASP
16/0918:13 oprette et installationsmedie Af Malm i Windows
16/0913:11 Adapterstik stik på ladekabel til USB-C Af ErikHg i Andet software
15/0911:19 Ios 27 iphone låst sim Af claes57 i Apps til iOS
White papers
Flere white papers »