Skrevet man. d. 26. juli 2010 kl. 22:09:02| #1
370177 skal selvfølgelig være 100177
Skrevet tir. d. 27. juli 2010 kl. 23:27:20| #2
Prøv at se om det er noget i den retning
Sub Makro1()
Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long
RW(1) = Range("A65536").End(xlUp).Row + 1
RW(2) = Range("B65536").End(xlUp).Row + 1
Data = Range("A:B")
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For I = 1 To UBound(Data)
OK = False
If IsEmpty(Data(I, 1)) Then Exit For
For N = 1 To UBound(Data)
If Data(I, 1) = Data(N, 2) Then
If I <> N Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Exit For
End If
Next
Data(I, 2) = Data(N, 2)
Data(N, 2) = Empty
RW(2) = RW(2) + 1
End If
OK = True
Exit For
End If
Next
If Not OK Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Data(I, 2) = Empty
Exit For
End If
Next
End If
Next
Range("A1").Activate
Range("D:E") = Data
End Sub
Skrevet ons. d. 28. juli 2010 kl. 08:18:10| #3
Hej Kabbak
Det ser godt ud, men der mangler lidt. Første del med at indsætte blanktegn virker helt perfekt, og listen med kontonumre i kolonne B, som ikke er i A er også, som jeg gerne vil have den. Jeg mangler bare at få listet de kontonumre i kolonne A, som ikke er i B.
Kan du knække den sidste del?
Skrevet ons. d. 28. juli 2010 kl. 10:28:23| #4
Kan listen af kontonumre i B, som ikke er i A, isoleres i et range, som jeg kan arbejde videre med? tilsvarende med numrene i A.
Skrevet ons. d. 28. juli 2010 kl. 20:41:00| #5
Sub Makro1()
Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long, Data1 As Variant
RW(1) = Range("A65536").End(xlUp).Row + 1
RW(2) = Range("B65536").End(xlUp).Row + 1
Data = Range("A:B")
Data1 = Range("G:H")
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For I = 1 To UBound(Data)
OK = False
If IsEmpty(Data(I, 1)) Then Exit For
For N = 1 To UBound(Data)
If Data(I, 1) = Data(N, 2) Then
If I <> N Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Exit For
End If
Next
Data(I, 2) = Data(N, 2)
Data(N, 2) = Empty
RW(2) = RW(2) + 1
End If
OK = True
Exit For
End If
Next
If Not OK Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Data(I, 2) = Empty
Exit For
End If
Next
End If
Next
X = 1
For I = 1 To UBound(Data)
If IsEmpty(Data(I, 1)) And Not IsEmpty(Data(I, 2)) Then
Data1(X, 2) = Data(I, 2)
X = X + 1
End If
If Not IsEmpty(Data(I, 1)) And IsEmpty(Data(I, 2)) Then
Data1(X, 1) = Data(I, 1)
X = X + 1
End If
Next
Range("A1").Activate
Range("D:E") = Data
Range("G:H") = Data1
End Sub
Skrevet tor. d. 29. juli 2010 kl. 08:41:03| #6
Super så er data på plads ;0). Mangler nu kun at kunne bearbejde Data1.
Hvis jeg ønsker selv at kunne styre hvor Data1 skal udskrives, hvordan får jeg så fundet antal elementer i det range som Data1 udgør. Jeg har brug for en for / next løkke, hvori jeg f.eks. kan styre placeringen af udskriften.
Skrevet tor. d. 29. juli 2010 kl. 23:26:52| #7
Husk Option Base 1, uden for kode
Option Explicit
Option Base 1
Sub Makro1()
Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long, Data1 As Variant
Dim NoMatch() As Variant
RW(1) = Range("A65536").End(xlUp).Row + 1
RW(2) = Range("B65536").End(xlUp).Row + 1
Data = Range("A:B")
Data1 = Range("G:H")
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For I = 1 To UBound(Data)
OK = False
If IsEmpty(Data(I, 1)) Then Exit For
For N = 1 To UBound(Data)
If Data(I, 1) = Data(N, 2) Then
If I <> N Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Exit For
End If
Next
Data(I, 2) = Data(N, 2)
Data(N, 2) = Empty
RW(2) = RW(2) + 1
End If
OK = True
Exit For
End If
Next
If Not OK Then
For X = I To UBound(Data)
If IsEmpty(Data(X, 2)) Then
Data(X, 2) = Data(I, 2)
Data(I, 2) = Empty
Exit For
End If
Next
End If
Next
X = 1
For I = 1 To UBound(Data)
If IsEmpty(Data(I, 1)) And Not IsEmpty(Data(I, 2)) Then
Data1(X, 2) = Data(I, 2)
X = X + 1
End If
If Not IsEmpty(Data(I, 1)) And IsEmpty(Data(I, 2)) Then
Data1(X, 1) = Data(I, 1)
X = X + 1
End If
Next
X = X - 1
' sætter de overskydende ind i NoMatch variablen
ReDim NoMatch(X, 2)
For I = 1 To X
NoMatch(I, 1) = Data1(I, 1)
NoMatch(I, 2) = Data1(I, 2)
Next
Data1 = Empty ' tømmer data1 fra hukommelsen
Range("A1").Activate
Range("D:E") = Data
Range("H5").Resize(UBound(NoMatch, 1), UBound(NoMatch, 2)) = NoMatch
End Sub
Skrevet lør. d. 31. juli 2010 kl. 08:25:28| #8
Super - det var afgrænsning af datasættet Data1 jeg manglede. Opgaven løst, så mangler jeg bare, at du lægger et svar.
Tak for hjælpen og rigtig god weekend :0))
Skrevet lør. d. 31. juli 2010 kl. 08:48:12| #9
Sætter lige lidt flere point på højkant.
Deles data1 i henholdsvis NoMatchA og NoMatchB, således at jeg har kolonne D i et range og Kolonne E i et andet. Hvordan får jeg så fjernet de tomme datasæt?
ReDim NoMatchA(X)
ReDim NoMatchB(X)
For I = 1 To X
NoMatchA(I) = Data1(I, 1)
NoMatchB(I) = Data1(I, 2)
Next
Skrevet søn. d. 01. august 2010 kl. 19:20:16| #10
Skrevet man. d. 02. august 2010 kl. 15:53:59| #11
Havde du mod på tillægsspørgsmålet?