CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

Laugesen1 Mester

03. januar 2014 - 19:43 Der er 11 kommentarer og
1 løsning

Samling af data fra flere ark i ét enkelt ark med VBA.

Jeg skal lave en makro der samler data fra flere ark i ét enkelt ark. Koden skal kunne overføre data for ugerne i en hel måned og indsæt dem samlet i et enkelt ark.

Hvert ark med kildedata indeholder data for en hel uge. Data skal sorteres efter flere kriterier, såsom dato, tidspunkt, ID-nr. og betalingskort.
Kun data der opfylder kriterierne skal overføres til samlingsarket.

Det er forskelligt fra uge til uge hvor mange rækker data der er fra kildedata. Arket med kildedata har altid overskrift i række 7 og data fra række 8 og ned efter. Kolonneoverskrifterne fra kildeark skal ikke overføres.

Der er data i 11 kolonner i kildearket (A:K) og de 4 kriterier der skal sorteres efter er følgende:

Kolonne C: Korttype
Kolonne D: Dato
Kolonne E: Tid
Kolonne F: ID-nr.

Data skal ikke indsættes i samme kolonner i samlingsarket, men i kolonnerne (J:T).

Case:
Destinationsark: Samling af data for ugerne i en hel måned.
Kildeark: Indeholder hver især data for en hel uge, og er navngivet med ugenummer til sidst i filnavnet, fx StamExcel.18
Der skal altså overføres data fra 4-6 kildeark hver måned, alt efter hvordan ugerne er fordelt på en hel måned.

Data skal afgrænses i starten og slutningen af måneden med kriterier for dato og klokkeslæt (første og sidste kildeark).

Fx fra 1. maj kl. 00:00 til 31.maj kl. 23:59. (klokkeslæt kan i princippet udelades, men da det kan forekomme i enkelte måneder, at afgræsningen skal flyttes nogle timer, er det bedst hvis dette kriterium tages med).

De andre kriterier skal være opfyldt i alle ugerne (ID-nr. og betalingskort).

Eksempel:
Hvis fx række 25 i et kildeark indeholder:
Kolonne C; VISA/DK
Kolonne D; 02-05-13
Kolonne E; > fx kl. 00:00
Kolonne F; ID0025
- skal data for hele række 25 (kolonne A:K) overføres til samlingsarket.

Data skal indsættes i destinationsarket forløbende, dvs. data fra 1. uge skal indsættes fra fx række 19 og ned efter. Derefter skal data fra 2. uge indsættes fra første tomme række (efter data fra 1. uge ) og videre ned. Det samme med de efterfølgende ark 2 - 4 ark.

Det sidste ark skal så sorteres, så der ikke kommer data med fra næste måned. (kriterium; data mindre end 31. maj kl. 23:59).

Se eksempel: http://gupl.dk/705894/

Er der nogen der ved hvordan den gribes an?

Laugesen

Synes godt om

kalasin Nybegynder

04. januar 2014 - 04:49 #1

Nu har jeg ikke lige excel eller vba ved hånden, så du får den fra hukommelsen.

Du kan starte med at definere en array i vba, som kan indholde de 11 poster for hver række. Sørg for at den er lang nok til at indeholde den maksimale situation.

Det er god skik lige at nulstille en array inden brug, så lav lige sådan en lille procedure/funktion.

Så laver du en procedure, hvor du ark for ark, række for række indsamler data - men kun hvis data opfylder betingelserne.

Nu har du de ønskede data i arrayen.

Nulstil destinationsarket.

Nu er du klar til at indsætte data. Det gør du ved at løbe arrayen og destinationsarket i gennem række for række , post for post, og indsætte posterne i destinationsarket.

Til slut slettes arrayen.

Hvis du ikke har prøvet det før, så vil det nok være en god idé at lave et lignende, men meget simpelt eksempel.

Synes godt om

Laugesen1 Mester

04. januar 2014 - 15:19 #2

Tak for dit input.

Jeg har læst om brugen af array og har prøvet at skrive det ind i en kode, men jeg har ikke kunnet få det til at fungere.

Har du mulighed for at komme med et eksempel på en kode med array, som jeg kan tilpasse mine ark?

Synes godt om

kalasin Nybegynder

04. januar 2014 - 15:38 #3

Jeg har ikke lige excel ved hånden, men det kunne lige noget a'la dette:

Dim Tabel(1 To 11, 1 To 200) As Variant ' to dimensionel
Dim i As Integer, j As Integer

'Læg i tabel
For i = 1 To 200
If kriteritest ok then
For j = 1 To 11
Tabel(i, j) = Cells(i, j).Value
Next j
endif
Next i

ect.

Din løsning vil blive lidt mere kompliceret i traveseringen, idet du flytter fra ark til ark, men kan sagtens køres.

Men prøv i et simpelt ark. Når du skal have data ud igen, så skifter tabel og cells plads omkkring "=" tegnet.

Synes godt om

kalasin Nybegynder

04. januar 2014 - 15:42 #4

Ups...
Dim Tabel(1 To 11, 1 To 200) As Variant skal ændres til
Dim Tabel(1 To 200, 1 To 11) As Variant

Synes godt om

Laugesen1 Mester

05. januar 2014 - 03:55 #5

Jeg er nu kommet lidt videre, men er både i tvivl om hvordan destinations-range skal defineres og hvordan de efterfølgende linjer der indsætter data, skal skrives.

Men allerførst; jeg får en fejl ved den indsatte kriterium-test.

For at gøre det så simpelt som muligt, har jeg alle data i den samme projektmappe. Når jeg har fået koden til fungere efter hensigten, kan jeg skrive de eksterne projektmapper ind i koden.

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer

'Læg i tabel
For i = 1 To 200

'Jeg får en fejlmeddelse ved næste linje
If ThisWorkbook.Sheets("Kreditkort").Range("C").Value = "VISA/DK" Then
For j = 1 To 11
Tabel(i, j) = Cells(i, j).Value
Next j
End If
Next i

'Ved ikke hvordan destinationsarket og range defineres !
'Er jeg på rette vej med de næste 3 linjer?
For i = 1 To 200
For j = 1 To 11
Cells(i, j).Value = Tabel(i, j)

Next j
Next i

End Sub

Synes godt om

kalasin Nybegynder

05. januar 2014 - 08:02 #6

Jeg har aldrig brugt Range, selvom det sikkert kan gøre livet nemmere.

I stedet ville jeg i dit eksempel skrive (idet jeg gætter på at det er indholdet i 3. kolonne, som skal undersøges:

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer

'Læg i tabel
For i = 1 To 200

'Jeg får en fejlmeddelse ved næste linje
If ThisWorkbook.Sheets("Kreditkort").cells(i,3).Value = "VISA/DK" Then
For j = 1 To 11
Tabel(i, j) = Cells(i, j).Value
Next j
End If
Next i

'Ved ikke hvordan destinationsarket og range defineres !
'Er jeg på rette vej med de næste 3 linjer? Jepper! Evt skal du før cells skrive ThisWorkbook.Sheets("Destinationsark")
For i = 1 To 200
For j = 1 To 11
Cells(i, j).Value = Tabel(i, j)

Next j
Next i

End Sub

Synes godt om

Laugesen1 Mester

05. januar 2014 - 14:43 #7

Jeg er kommet endnu et skridt videre :)

Havde først det problem, at makroen kun kunne køres fra kildearket. Har skrevet en linje der først aktiverer kildearket.
Ved ikke helt om det er den rigtige måde at gøre det på?

Men jeg har 2 problemer mere !

1.
Når data sættes ind i destinationsarket, så er der tomme rækker ind i mellem. Måske det fremkommer når kriterium-test ikke opfyldes, så bliver der kopieret en tom række over i destinationsarket ?

2.
Jeg har udvidet koden til at flytte data fra to kildeark (arkene er stadig i samme projektmappe). Men data fra det første kildeark bliver overskrevet af data fra andet kildeark. Undtagen de første par rækker, de indeholder stadig data fra første kildeark.

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer

'Læg i tabel
For i = 1 To 200

'Hvis ikke jeg aktiverer arket først med næste linje, kan maroen kun køres fra kildearket.
'Er der en nemmere måde at gøre det på, eller er dette fremgangsmåden?
ThisWorkbook.Sheets("Kreditkort").Activate
If ThisWorkbook.Sheets("Kreditkort").Cells(i, 3).Value = "VISA/DK" Then
For j = 1 To 11
Tabel(i, j) = Cells(i, j).Value
Next j
End If
Next i

'Evt skal du før cells skrive ThisWorkbook.Sheets("Destinationsark")
For i = 1 To 200
For j = 1 To 11
ThisWorkbook.Sheets("Ark1").Cells(i, j).Value = Tabel(i, j)

Next j
Next i

For i = 1 To 200

ThisWorkbook.Sheets("Kreditkort2").Activate
If ThisWorkbook.Sheets("Kreditkort2").Cells(i, 3).Value = "VISA/DK" Then
For j = 1 To 11
Tabel(i, j) = Cells(i, j).Value
Next j
End If
Next i

'Evt skal du før cells skrive ThisWorkbook.Sheets("Destinationsark")
For i = 1 To 200
For j = 1 To 11
ThisWorkbook.Sheets("Ark1").Cells(i, j).Value = Tabel(i, j)

Next j
Next i

End Sub

Synes godt om

kalasin Nybegynder

07. januar 2014 - 20:44 #8

Svar på 1:

Ja det er klart, at du får tomme rækker. Det havde jeg ikke lige tænkt på. Du får en tom række, hver gang der er en linie, hvor kriteriet ikke er mødt. Du anvender med andre ord samme tæller til kilde og destination.

Der er et par metoder, her er den hvor du lægger rigtigt ind i tabellen. Du skal bruge en tredie integer k til at holde styr på tabellen, mens i holder styr på kildedataarket.

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer,k As Integer

k=1 ' initiering

'Læg i tabel
For i = 1 To 200

'Jeg får en fejlmeddelse ved næste linje
If ThisWorkbook.Sheets("Kreditkort").cells(i,3).Value = "VISA/DK" Then
For j = 1 To 11
Tabel(k, j) = Cells(i, j).Value
Next j
k = k +1
End If
Next i

'Ved ikke hvordan destinationsarket og range defineres !
'Er jeg på rette vej med de næste 3 linjer? Jepper! Evt skal du før cells skrive ThisWorkbook.Sheets("Destinationsark")
For k = 1 To 200
For j = 1 To 11
Cells(k, j).Value = Tabel(k, j)

Next j
Next k

End Sub

Synes godt om

kalasin Nybegynder

07. januar 2014 - 20:48 #9

Svar på 2

Du kan godt gå frem, som du beskriver - og så er der lidt mere raffinerede metoder, når du bliver mere erfaren - forestil dig fx. at du skal trække data fra 200 ark....

Men som i svar 1 skal du introducere k til at holde styr på tabellen. Den vokser så bare fra ark til ark efterhånden som flere linier matcher kriteriet.

Synes godt om

Laugesen1 Mester

08. januar 2014 - 17:43 #10

Det går den rigtige vej og nu virker koden, så den kan flytte data fra 2 ark over i destinationsarket. Og der kommer ikke nogen tomme rækker :)

Jeg mangler nu kun at få styr på kriterierne dato og klokkeslæt. De formater for dato jeg har skrevet, bliver automatisk ændret. Formatet for klokkeslæt bliver ikke ændret.

Men ingen af de to søgekriterier fungerer. Jeg ved ikke om det er fordi jeg har skrevet i et forkert format, eller om søgekriteriet skal sættes ind i koden på en anden måde.

Har du et bud på hvad der er galt ?

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer, k As Integer

Application.ScreenUpdating = False
k = 1 ' initiering

'Læg i tabel
For i = 1 To 200

ThisWorkbook.Sheets("Kreditkort").Activate

'Ved angivelse af søgkriterie for dato, har jeg prøvet både at skrive i formaterne; "04/05/13" og "04-05-2013". Men datoen bliver automatisk ændret til formatet i næste linje.
If ThisWorkbook.Sheets("Kreditkort").Cells(i, 3).Value = "VISA/DK" And Sheets("Kreditkort").Cells(i, 4).Value >= "4 - 5 - 13" And Sheets("Kreditkort2").Cells(i, 5).Value >= "20:45" Then
For j = 1 To 11
Tabel(k, j) = Cells(i, j).Value
Next j
k = k + 1
End If

ThisWorkbook.Sheets("Kreditkort2").Activate
If ThisWorkbook.Sheets("Kreditkort2").Cells(i, 3).Value = "VISA/DK" And Sheets("Kreditkort2").Cells(i, 6).Value >= "ID0025" Then
For j = 1 To 11
Tabel(k, j) = Cells(i, j).Value
Next j
k = k + 1
End If

Next i

For k = 1 To 200
For j = 1 To 11
ThisWorkbook.Sheets("Ark1").Range("F15").Cells(k, j).Value = Tabel(k, j)

Next j
Next k

ThisWorkbook.Sheets("Ark1").Activate
Application.ScreenUpdating = True

End Sub

Synes godt om

kalasin Nybegynder

08. januar 2014 - 22:06 #11

Prøv denne her. (Måske skal kolonnerne have korrekt dato/tidsformat...?)

Public Sub TestFlytData()
Dim Tabel(1 To 200, 1 To 11) As Variant
Dim i As Integer, j As Integer, k As Integer

'Application.ScreenUpdating = False
k = 1 ' initiering

'Læg i tabel

'Nulstil array
For i = 1 To 200
For j = 1 To 11
Tabel(i, j) = ""
Next j
Next i

For i = 1 To 200
If ThisWorkbook.Sheets("Kreditkort").Cells(i, 3).Value = "VISA/DK" And ThisWorkbook.Sheets("Kreditkort").Cells(i, 4).Value < DateValue("02-07-2013") And ThisWorkbook.Sheets("Kreditkort").Cells(i, 6).Value > TimeValue("15:30:00") Then
For j = 1 To 11
Tabel(k, j) = ThisWorkbook.Sheets("Kreditkort").Cells(i, j).Value
Next j
k = k + 1
End If
Next i

For k = 1 To 200
For j = 1 To 11
ThisWorkbook.Sheets("Ark1").Cells(k, j).Value = Tabel(k, j)
Next j
Next k

' Application.ScreenUpdating = True

End Sub

Synes godt om

Laugesen1 Mester

09. januar 2014 - 10:34 #12

Så virker koden helt efter hensigten og med sortering efter alle kriterierne. Jeg har formateret kolonnerne i destinationsarket for dato og klokkeslæt, og givet dato-kolonnen en sortering med ældste dato først.

Nu kan jeg gå i gang med at skrive ind i koden, at der skal hentes data fra eksterne projektmapper.

Mange tak for hjælpen, du er kommet med rigtig god input.

Laugesen

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

Excel kurser

Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Identificér og hent del af tekststreng Af TheLibrarian i Excel	1	I går 16:49	I går 21:00
Ændre nuller til ovenstående tekst Af boro23 i Excel	4	20/11/202410:44	20/11/202412:08
HVIS med datoer Af HHA i Excel	6	20/11/202408:31	20/11/202412:51
Numerisk liste Af AND i Excel	8	19/11/202414:05	19/11/202423:31
Ændre nuller til ovenstående tal Af boro23 i Excel	3	19/11/202409:39	19/11/202411:51

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.

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten

Seneste artiklerRSS