I denne artikel vil vi oprette en makro til kopiering af data fra flere projektmapper i en mappe til en ny projektmappe.
Vi opretter to makroer; en makro vil kun kopiere poster fra første kolonne til den nye projektmappe, og anden makro vil kopiere alle dataene ind i den.
Rådata for dette eksempel består af tilstedeværelsesregistre over medarbejdere. I TestFolder har vi flere Excel -filer. Filnavne på Excel -filer repræsenterer en bestemt dato i "ddmmyyyy" -format.
Hver Excel -fil indeholder dato, medarbejder -id og medarbejdernavn på de medarbejdere, der var til stede den pågældende dag.
Vi har oprettet to makroer; "CopyingSingleColumnData" og "CopyingMultipleColumnData". Makroen "CopyingSingleColumnData" kopierer kun poster fra den første kolonne af alle filerne i mappen til den nye projektmappe. Makroen "CopyingMultipleColumnData" kopierer alle data fra alle filerne i mappen til den nye projektmappe.
Makroen "CopyingSingleColumnData" kan udføres ved at klikke på knappen "Kopiering af en enkelt kolonne". Makroen "CopyingMultipleColumnData" kan udføres ved at klikke på knappen "Kopiering af flere kolonner".
Inden man kører makroen, skal man angive stien til mappen i tekstfeltet, hvor Excel -filer placeres.
Når der klikkes på knappen "Kopiering af en enkelt kolonne", genereres en ny projektmappe "ConsolidatedFile" i den definerede mappe. Denne projektmappe vil indeholde konsoliderede data fra første kolonne af alle filerne i mappen.
Den nye projektmappe indeholder kun poster i den første kolonne. Når vi har de konsoliderede data, kan vi finde ud af antallet af medarbejdere, der er til stede på en bestemt dag, ved at tælle datoen. Optælling af en bestemt dato vil være lig med antallet af medarbejdere til stede på den pågældende dag.
Når der klikkes på knappen "Kopiering af flere kolonner", genererer den den nye projektmappe "ConsolidatedAllColumns" i den definerede mappe. Denne projektmappe indeholder konsoliderede data fra alle poster i alle filerne i mappen.
Den nye projektmappe, der er oprettet, indeholder alle poster fra alle filerne i mappen. Når vi har de konsoliderede data, har vi alle tilstedeværelsesoplysninger tilgængelige i en enkelt fil. Vi kan let finde antallet af medarbejdere til stede den pågældende dag og også få navne på de medarbejdere, der var til stede den pågældende dag.
Kode forklaring
Ark1.Tekstboks1.Værdi
Ovenstående kode bruges til at få værdien indsat i tekstfeltet "TextBox1" fra arket "Sheet1".
Dir (FolderPath & "*.xlsx")
Ovenstående kode bruges til at hente navnet på filen, som har filtypenavnet ".xlsx". Vi har brugt wildcard * til filnavn med flere tegn.
Mens filnavn ""
Count1 = Count1 + 1
ReDim Preserve FileArray (1 at tælle1)
FileArray (Count1) = Filnavn
Filnavn = Dir ()
Wend
Ovenstående kode bruges til at hente filnavne på alle filerne i mappen.
For i = 1 Til UBound (FileArray)
Næste
Ovenstående kode bruges til at gennemgå alle filerne i mappen.
Område ("A1", celler (LastRow, 1)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1)
Ovenstående kode bruges til at kopiere post fra den første kolonne til destinationsarbejdsbogen.
Område ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1)
Ovenstående kode bruges til at kopiere al posten fra den aktive projektmappe til destinationsarbejdsbogen.
Følg venligst nedenstående for koden
Option Explicit Sub CopyingSingleColumnData () 'Deklarerende variabler Dim FileName, FolderPath, FileArray (), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox' Indsætning af backslash i mappestien, hvis backslash (\) mangler Hvis Right (FolderPath, 1) "\" Herefter FolderPath = FolderPath & "\" End If 'Søger Excel -filer FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Gennemgang af alle Excel -filer i mappen Mens FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Oprettelse af en ny projektmappe Angiv DestWB = Workbooks.Add For i = 1 Til UBound (FileArray) 'Find den sidste række i projektmappen LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Åbning af Excel -projektmappen Angiv kildeWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Indsætter de kopierede data til sidste række i destinationsarbejdsbogen Hvis LastDesRow = 1 Herefter' Kopierer den første kolonne til sidste række i destinationsarbejdsbogens område ("A1", Celler (LastRow, 1)). Kopier DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Kopier DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Gem og luk en ny Excel projektmappe DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Intet sæt SourceWB = Intet ende Sub Sub CopyingMultipleColumnData () 'Deklarationsvariabler Dim Filnavn, FolderPath, FileArray (), Filnavn1 som streng DimRække, LastDes , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Indsætning af backslash i mappestien, hvis backslash (\) mangler Hvis Right (FolderPath, 1) "\" Herefter FolderPath = FolderPath & "\" End If 'Søgning efter Excel -filer FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Looping gennem alle Excel -filer i mappen Mens FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Oprettelse af en ny projektmappe Sæt DestWB = Workbooks.Add For i = 1 Til UBound (FileArray) 'Find den sidste række i projektmappen LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Række' Åbning af Excel -projektmappen Angiv kildeWB = Workbooks.Open (FolderPath & FileArray (i)) 'Indsætter de kopierede data til sidste række i destinationsarbejdsbogen Hvis LastDesRow = 1 Herefter' Kopierer alle data i regnearket til sidste række i destinationsarbejdsbogens område ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Gem og luk en ny Excel -projektmappe DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Intet angivet kildeWB = Intet slut Sub
Hvis du kunne lide denne blog, kan du dele den med dine venner på Facebook. Du kan også følge os på Twitter og Facebook.
Vi vil meget gerne høre fra dig, lad os vide, hvordan vi kan forbedre vores arbejde og gøre det bedre for dig. Skriv til os på e -mail -stedet