Flytning af rækker med fælles nævner, fra et ark til et andet
Hej, jeg arbejder i det administrative på en skole, og vi har gennem et år rigtig mange kursister igennem. Dette kan godt give nogle administrative problemer specielt når vi skal flytte kursister fra et ark til et andet. et eksempel på dette kan være som nedstående:
Hold: xxxxx lære: xxxxx Holdform: xxxxx
Tilskud: xxxx Tilskudsform: xxxxx Bidrag: xxxxx
Aktivitet xxxx timer: xxxxx antal kursister: xxxxx
020202-0202, Hans Ole, X, 21-06-15 til 30-12-15, 0,025, 14/15
020202-0202, Inge Olsen, X, 21-06-15 til 30-12-15, 0,025, 14/15
020202-0202, Poul Erik, X, 21-06-15 til 30-12-15, 0,025, 14/15
Det ovefor ser som så ikke problematisk ud men det eneste vi skal bruge af det der står oven for er eks. 020202-0202, Hans Ole, X, 21-06-15 til 30-12-15, 0,025, 14/15 hold, lære. holdform, tilskud, bidrag, aktivitet, timer og antal af kursister kan som så være fuldstændig ligegyldige i denne sammenhæng.
Havde det nu kun været 3 rækker ville der ikke være noget problem med simpel copy paste, men vi kigger årligt på omkring 40.000 rækker hvor der er ca. 20 kursister og så en ny headline hvor der står hold, holdnummer osv.
så det jeg godt kunne tænke mig at høre om, var hvis der var nogle kloge hoveder der viste om man kan lave en makro der kan finde alle kursister, og kopiere dem ind i et regneark vedsiden af den der er åben. pt. bruger jeg en jeg fik bikset sammen men den kan kun kopirer en række af gangen hvilket godt kan blive noget langhåret når man ser på omkring 40.000 rækker.
den formel jeg har lavet hedder følgende Dim targetRow As Long
Når du siger en database mener du så at access er en database? Og i så fald er der evt. nogle begynder tips ang. access du kan give til en komplet nybegynder?
Nu har jeg lige åbnet access for at se, og kan se jeg skal bruge navnene osv. for at plotte dem ind i access, og det var egentlig det jeg ville frem til med mit spørgsmål om hvordan jeg hev navne, cpr, dato, hold osv. ud af et stort excel ark fordi access løser som så ikke mit problem medmindre den selv kan scanne efter navne osv.
Jeg vil tro, at denne makro kan klare det. Den antager, at tabellen starter i celle A1 på det aktive ark. Rækker, hvor de første 11 karakterer er 020202-0202, kopieres til et array, der til slut indsættes som tabel i et nyt regneark.
Sub FindKursister() Dim rRange As Range Dim arInput() Dim arOutput() Dim lCount As Long Dim lCol As Long Dim lRow As Long
On Error GoTo ErrorHandle
'Definerer rRange som tabellen. 'Antager at alt står i kolonne A. 'Går tabellen fx til og med kolonne C, 'skal "A1" herunder ændres til "C1". Set rRange = Range("A" & Rows.Count)
If IsEmpty(rRange) Then 'I linjen herunder skal A1 ændres, hvis der er 'flere kolonner. Set rRange = Range(rRange.End(xlUp), Range("A1")) Else 'I linjen herunder skal A1 ændres, hvis der er 'flere kolonner. Set rRange = Range(rRange, Range("A1")) End If
'Kopierer tabellens indhold til arrayet arInPut. arInput = rRange.Value
'Redimensionerer outputarrayet With rRange ReDim arOutput(1 To .Rows.Count, 1 To .Columns.Count) End With
'Gennemløber inputarrayet og finder rækkerne 'med kursister. Disse rækker kopieres til 'outputarrayet. For lCount = 1 To UBound(arInput) 'Hvis de første 11 karakterer matcher "020202-0202" 'kopierer vi rækken til outputarrayet If Left(arInput(lCount, 1), 11) = "020202-0202" Then lRow = lRow + 1 For lCol = 1 To UBound(arInput, 2) arOutput(lRow, lCol) = arInput(lCount, lCol) Next End If Next
'Åbner et nyt regneark og aktiverer det With Workbooks .Add .Item(.Count).Activate End With
'Definerer et indsætningsområde for kursist-tabellen Set rRange = Range("A1").Resize(rRange.Rows.Count, rRange.Columns.Count)
'Kopierer outputarrayet til regnearket rRange.Value = arOutput
BeforeExit: On Error Resume Next Set rRange = Nothing Erase arInput Erase arOutput
Exit Sub ErrorHandle: MsgBox Err.Description Resume BeforeExit End Sub
Synes godt om
Ny brugerNybegynder
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.
