Makro som sammenligner rækker

Man kan måske for nemheds skyld lave en "skjult" værdi i ark 1 i f.eks. række 1 og en tilsvarende i række 10 og sige at makroen skal sammenligne alle linier derimellem de to værdier, og tilsvarende på ark 2?

Slet ingen hjælp....æv

Public Sub test()
Dim Data1 As Variant, Data2 As Variant, I1 As Integer, I2 As Integer, X As Integer
X = 0
    Data1 = Range("A1:A20")
    Data2 = Sheets(2).Range("A1:A20")
    For I1 = 1 To 20
        For I2 = 1 To 20
            If Data1(I1, 1) = Data2(I2, 1) Then
              X = X + 1
            End If
        Next
    Next
    If X <> 20 Then MsgBox " de er ikke ens"
End Sub

sub compare(sheet1 as string, sheet2 as string)
dim oSheet1 as range
set oSheet1 = thisworkbook.sheets(sheet1).range("A1")
dim row as long, i as long

with thisworkbook.sheets(sheet2).range("A1")
row = 1
do while len(trim(.offset(row,0))) > 0
  i = 1
  do while len(trim(oSheet1.offset(i,0))) > 0
  if oSheet1.offset(i,0) = .offset(row,0) then
    .offset(row,1) = "Match"
    exit do
  end if
  i = i + 1
  loop
  row = row + 1
loop
end with

kinky....

min fejler hvis der er 2 ens værdier på samme ark

nu er det vist luset af

Public Sub test()
    Dim Data1 As Variant, Data2 As Variant, I1 As Integer, I2 As Integer, X As Integer
    X = 0
    Data1 = Sheets(1).Range("A1:A20")
    Data2 = Sheets(2).Range("A1:A20")
    For I1 = 1 To 20
        For I2 = 1 To 20
            If Data1(I1, 1) = Data2(I2, 1) Then
                Data2(I2, 1) = " "
                X = X + 1
                Exit For
            End If
        Next
    Next
    If X <> 20 Then MsgBox " de er ikke ens"
End Sub

Lige en lille ekstra ting. Mine områder i de to ark behøver ikke at starte i f.eks. A1, men kan variere. Og ligeledes behøver det heller ikke at være i B1 på ark 2 at det samme område starter.

Derfor tænkte jeg at man kunne skrive et tal/tegn e.l. i f.eks. celle E1 ud for den første linie i området og et tal/tegn ud for den sidste linie i området.

Det vil så være dette område som skal sammenlignes på de to ark. Eller skal man definere området med formlen FORSKYDNING. Hvad er nemmest ?

P.S. Hvordan virker den funktion hvis der f.eks. er skjulte linier ? Bliver de også sammenlignet ?

Det er lige meget om området starter i A1 eller ej - det kan bare ændres. Derimod mener jeg at .offset funktionen springer skjulte områder over.. men er ikke sikker
Du kan altid forsøge dig frem med hvordan skjulte områder behandles

Du kan sagtens bruge at definere ranget inde i Excel, og så bruge

dim sRange1 as string, sRange2 as string
sRange1 = sheets("Det ark hvor du skriver referencen").range("cellen med referencen")
sRange2 = sheets("Det ark hvor du skriver referencen").range("cellen med referencen")

Data1 = sheets(1).range(sRange1)
Data2 = sheets(2).range(sRange2)

referencen du skriver i cellen iExcel vil så være a'la A1:A20

Prøv at lege med denne function

Public Function Sammenlign_område(FørsteListe As Range, AndenListe As Range)
    If FørsteListe.Cells.Count <> AndenListe.Cells.Count Then
        Sammenlign_område = "Fejl i antal celler"
        Exit Function
    End If
    Dim Data1 As Variant, Data2 As Variant, I1 As Long, I2 As Long, X As Long, Antal As Long
    Antal = FørsteListe.Cells.Count
   
    Data1 = FørsteListe
    Data2 = AndenListe
    For I1 = 1 To Antal
        For I2 = 1 To Antal
            If Data1(I1, 1) = Data2(I2, 1) Then
                Data2(I2, 1) = " "
                X = X + 1
                Exit For
            End If
        Next
    Next
    If X <> Antal Then
        Sammenlign_område = False
    Else
        Sammenlign_område = True
    End If
End Function

Kabbak

Så skal jeg navngive områderne Data1 og Data2 ? Er det sådan jeg skal forstå det ?

Hvor meget sammenligner denne funktion. Rækkehøjde, tekst, tal, cellestørrelse ?? Ved du det ?

Sorry FørsteListe og AndenListe skal de vel navngives

Jeg er desværre ikke klog nok til at få det til at virke. Hvor skal makroen placeres ?

Mit ønske:

At denne makro aktivere/kører hver gang jeg forlader arket "til".
Den skal tjekke at et område Område1 (i ark "fra") altid er ligmed Område2 (i ark "til". Disse områder er i hvert sit ark.

Områderne starter på f.eks. række 12 i ark "fra" og i række 42 på ark "til". Derfor skal områderne altid sammenlignes kun fra række 12 i det ene ark med området fra række 42 i det andet ark. De slutter henholdsvis på række 22 og 52.

Der kan indsættes linier før dette område, efter dette område og i dette område.

Hvordan fanger jeg disse områder ? Når de kan ændres

Nogle tilbagemeldinger herpå ?

Det er en funktion, den skal være samme sted som når du optager en makro


du kalder den i en celle ved at skrive

=Sammenlign_område(1.område du vil tjekke ;2.område du vil tjekke)

den retuner SAND eller FALSK

Nu har jeg placeret funktionen sammen med mine andre makroer.

Jeg har smidt =Sammenlign_område(FørsteListe;AndenListe) i en celle.

Men den returnerer værdien #navn?

FørsteListe og AndenListe, skal erstattes af de områder du vil tjekke
f. eks sådan

=Sammenlign_område(Ark2!A1:A20;Ark3!B1:B20)

Kan man ikke navngive områderne ?

Hvis ikke, kan man så bruge funktionen "Forskydning" e.l. så man altid har et variabelt område navngivet

Det virker heller ikke uden navngivning. Jeg har placeret funktionen i ThisWorkBook

den skal i et Modul, ikke i ThisWorkBook og arkmoduler.

Selvom jeg putter den i et modul får jeg stadig den samme fejlværdi i min formelcelle

Er der nogen som har mod på lidt mere hjælp.

Desværre synes jeg ikke jeg kan få det til at virke...

Rem Sammenlign - version 2 (4/1-2007)
Rem Definition af områder
Rem Start ===============
Const aForside = "Fors."
Const StartOmråde = "Start1"                        'listeNavn
Const AStart = "Rev.påt."

Rem Slut ================
Const ASlut = "Rev.prot."
Const SlutOmråde = "Slut1"                          'listeNavn

Dim startR1, startK1, startR9, startK9, slutR1, slutK1, slutR9, slutK9
Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = AStart Or Sh.Name = ASlut Then
        sammenlignArk
    End If
End Sub
Private Sub sammenlignArk()
Dim ræk, kol, rx, kx, cSlut, cStart, p, startAdresser, slutAdresser

    startAdresser = Range(ActiveWorkbook.Names(StartOmråde)).Address
    p = InStr(startAdresser, ":")
    startR1 = Range(Left(startAdresser, p - 1)).Row
    startK1 = Range(Left(startAdresser, p - 1)).Column
   
    startR9 = Range(Mid(startAdresser, p + 1)).Row
    startK9 = Range(Mid(startAdresser, p + 1)).Column
   
    slutAdresser = Range(ActiveWorkbook.Names(SlutOmråde)).Address
    p = InStr(slutAdresser, ":")
    slutR1 = Range(Left(slutAdresser, p - 1)).Row
    slutK1 = Range(Left(slutAdresser, p - 1)).Column
   
    slutR9 = Range(Mid(slutAdresser, p + 1)).Row
    slutK9 = Range(Mid(slutAdresser, p + 1)).Column
     
    rx = slutR1
    kx = slutK1
   
    For ræk = startR1 To startR9
        For kol = startK1 To startK9
            cStart = Sheets(AStart).Cells(ræk, kol)
            cSlut = Sheets(ASlut).Cells(rx, kx)
           
            If cSlut <> cStart Then
                ActiveWorkbook.Sheets(aForside).Cells(1, 12) = "Forskel mellem " + AStart + " og " + ASlut
                Exit Sub
            End If
            kx = kx + 1
        Next kol
        kx = slutK1
        rx = rx + 1
    Next ræk
   
Rem Ingen forskel
    ActiveWorkbook.Sheets(aForside).Cells(1, 12) = ""
End Sub