Jeg er helt og aldeles grøn i VBA til excel, og vil derfor blive glad hvis der er nogen der vil hjælpe mig igang med nedenstående. Jeg vil gerne have programmeret en makro til sammenligning og sortering af celleindhold. Jeg har data som som herunder:
Der her er bare et tænkt eksempel, mine datamængder er meget større, men princippet er her da :-)
Det jeg gerne vil have en makro til at gøre er at se på x1 og y1 værdierne i række 1. Hvis der findes x2 y2 værdier i en vilkårlig række (skal være i samme række) skal de kopieres til en anden liste i enten nyt ark eller bare en kollonne længere henne i arket. Dette fortsættes med alle x1 og x2 sættene, hvilket giver en liste over de x og y værdier der er ens i 1 og 2. En ny liste laves tilsvarende med sammenligninger mellem x1, y1 og x3 og y3 og senere med x4, y4. Der forsættes med sammenligninger hvor x2, y2 nu sammenlignes med de andre (3 og 4). Det giver så en del nye liste med sammenligninger mellem de fire datasæt (1, 2, 3 og 4). Der skal også laves sammenligninger hvor der ses på om der findes datasæt som findes både i sæt 1, 2 og 3 osv. og endelig en sammenligning der giver ens datasæt i alle 4 datasæt.
Det var en lang smøre men håber I er med på hvad jeg mener og kan hjælpe mig igang. Senere skal jeg så faktisk have det udvidet til at sammenligne 8 datasæt, men vil lige prøve dette først for at få det til at funke.
Med kunstig intelligens skaber HP’s nye OmniBook X 14 en unik og skræddersyet brugeroplevelse målrettet dem, der ønsker høj ydeevne og intelligente funktioner
Ok jeg prøver det hele starter i A1, det er der der står x1
Koden skulle passe til alle så langtid det er parvis data
Den skriver resultatet en ved siden af originalen, med en tom kolonne imellem.
Du skal selv slette skriveområdet, ved anden kørsel.
Public Sub SammenlignArray() Dim Data As Variant, I As Long, X As Integer, T As Integer Data = Range("A1").CurrentRegion
For X = 1 To UBound(Data, 2) Cells(1, X + UBound(Data, 2) + 1) = Data(1, X) Next
For I = 2 To UBound(Data, 1) For T = 1 To UBound(Data, 2) Step 2 For X = T + 2 To (UBound(Data, 2)) Step 2 If (Data(I, T) = Data(I, X)) And (Data(I, T + 1) = Data(I, X + 1)) Then Cells(I, T + UBound(Data, 2) + 1) = Data(I, T) Cells(I, T + 1 + UBound(Data, 2) + 1) = Data(I, T + 1) Cells(I, X + UBound(Data, 2) + 1) = Data(I, X) Cells(I, X + 1 + UBound(Data, 2) + 1) = Data(I, X + 1) End If Next Next Next End Sub
Tak for det, men jeg har vist fået vrøvlet lidt :-( Det forslag du har givet sammenligner x1,y1 værdier med x2,y2 og x3,y3 og x4,y4 i samme række, og det ser ud til at virke.
Men det jeg ønsker (modsagde mig selv i spørgsmålet) er at sammenligne x1,y1 værdierne i en vilkårlig række med ALLE x2,y2 og x3,y3 og x4,y4 sættene. Dvs. hvis man starter med x1,y1 sættet i række 2 skal den sammenlignes med ALLE x2,y2 værdierne, dvs. sættene i alle rækkerne. Og x1,y1 sættene skal så også sammenlignes med ALLE x3,y3 og x4,y4 sættene. Derudover skal jeg også sammenligne flere sæt med hinanden, altså vil jeg få følgende sammenligninger (1=x1,y1 ; 2=x2,y2 ; 3=x3,y3 ; 4=x4,y4) hvor hver celle sammenlignes med alle celler i de andre sæt (det burde vist være alle kombinationer:
Den skriver det i blokke, under hinanden, og en kolonne til højre for original data, for hver der tjekkes, hvilken kolonne og række der tjekkes skrives i kolonnen til højre for det skrevne.
Public Sub SammenlignArray() Dim Data As Variant, I As Long, X As Integer, T As Integer, Z As Integer, H As Integer Data = Range("A1").CurrentRegion
H = 1 ' styring af start skrive række y = UBound(Data, 2) + 1 ' styring af start skrive kolonne For T = 1 To UBound(Data, 2) - 2 Step 2 ' kolonnen på den der sammenlignes
For I = 2 To UBound(Data, 1) ' rækken på den der sammenlignes For X = 1 To UBound(Data, 2) Cells(H, X + y) = Data(1, X) ' Overskrifter Next Cells(H, X + y) = "Kolonne" & T & "&" & T + 1 & "," & "Række" & I - 1 For X = T + 2 To (UBound(Data, 2)) Step 2 ' kolonnen på den der sammenlignes med For Z = 2 To UBound(Data, 1) ' rækken på den der sammenlignes med
If (Data(I, T) = Data(Z, X)) And (Data(I, T + 1) = Data(Z, X + 1)) Then Cells(I + (H - 1), T + y) = Data(I, T) Cells(I + (H - 1), T + 1 + y) = Data(I, T + 1) Cells(Z + (H - 1), X + y) = Data(Z, X) Cells(Z + (H - 1), X + 1 + y) = Data(Z, X + 1) End If
I det ark jeg tester på nu er der "kun" 306 rækker med data, men senere skal det gerne kunne køre med et par tusind. Der ser ud til den når bunden ved at lave en del rækker med overskriften med x1,y1,x2 osv. ned igennem dokumentet. Kan ikke lige helt gennemskue hvorfor men det er på række: 1 306 611 916 1221 1526 2136 osv. til bunden
Det ser ud til den tester kolonne1&2 rækkevis og skriver hver eneste sammenligning adskilt på ovenstående rækker. Derfor vil den jo nå bunden og resultaterne er så spredt over hele arket(nedad). Den nederste er: Kolonne1&2,Række215
Men det er nu noget uoverskueligt at se på resultaterne bagefter på den måde.
Det ville være lettere hvis der f.eks. for hver sammenligning blev lavet en ny kolonne ved siden af datadelen hvor f.eks. de datasæt der findes i begge/alle dem der sammenlignes skrives. Håber det er forståeligt, prøver lige at illustrere:
Jeg tro ikke det kan lade sig gøre, hvis vi siger at du har 3000 rækker
x1 og y1 = 3000 x 3000 x3 data = 27.000.000 celler hver par(x1 og y1) sammenlignes med alle andre par x2 og y2 = 3000 x 3000 x2 data = 18.000.000 celler x3 og y3 = 3000 x 3000 data = 9.000.000 celler
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.
