26. juli 2010 - 22:07Der er
10 kommentarer og 1 løsning
Sammenlign to kolonner og sæt identiske kontonumre overfor hinanden.
Hejsa Jeg har to kolonner (A og B) med kontonumre. Der er mange sammenfald i de to kolonner. Jeg ønsker at få identiske ordrenumre til at stå ud for hinanden. De skal ske ved at indsætte blanke felter i de to kolonner.
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
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")
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?
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")
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
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.
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")
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
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))
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
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.
