Šajā rakstā mēs izveidosim makro, lai kopētu datus no vairākām darbgrāmatām mapē uz jaunu darbgrāmatu.
Mēs izveidosim divus makro; viens makro tikai kopēs ierakstus no pirmās kolonnas uz jauno darbgrāmatu, bet otrais makro visus datus.
Neapstrādātie dati šajā piemērā sastāv no darbinieku apmeklējuma ierakstiem. TestFolder mums ir vairāki Excel faili. Excel failu failu nosaukumi attēlo noteiktu datumu “ddmmyyyy” formātā.
Katrā Excel failā ir datums, darbinieka ID un to darbinieku vārdi, kuri bija klāt konkrētajā dienā.
Mēs esam izveidojuši divus makro; “CopyingSingleColumnData” un “CopyingMultipleColumnData”. Makro “CopyingSingleColumnData” kopēs ierakstus no visu mapē esošo failu pirmās slejas uz jauno darbgrāmatu. Makrons “CopyingMultipleColumnData” kopēs visus datus no visiem mapē esošajiem failiem uz jauno darbgrāmatu.
Makro “CopyingSingleColumnData” var izpildīt, noklikšķinot uz pogas “Kopēt vienu kolonnu”. Makro “CopyingMultipleColumnData” var izpildīt, noklikšķinot uz pogas “Kopēt vairākas kolonnas”.
Pirms makro palaišanas tekstlodziņā ir jānorāda mapes ceļš, kurā tiek ievietoti Excel faili.
Noklikšķinot uz pogas “Kopēt vienu kolonnu”, definētajā mapē tiks ģenerēta jauna darbgrāmata “ConsolidatedFile”. Šajā darbgrāmatā būs konsolidēti dati no visu mapē esošo failu pirmās slejas.
Jaunās darbgrāmatas pirmajā slejā būs tikai ieraksti. Kad mums ir konsolidētie dati, mēs varam noskaidrot konkrētajā dienā esošo darbinieku skaitu, saskaitot datuma skaitu. Konkrēta datuma skaits būs vienāds ar konkrētajā dienā klātesošo darbinieku skaitu.
Noklikšķinot uz pogas “Kopēt vairākas kolonnas”, definētajā mapē tiks ģenerēta jauna darbgrāmata “ConsolidatedAllColumns”. Šajā darbgrāmatā būs konsolidēti dati no visiem mapē esošo failu ierakstiem.
Izveidotajā jaunajā darbgrāmatā būs visi ieraksti no visiem mapē esošajiem failiem. Kad esam ieguvuši konsolidētos datus, visa informācija par apmeklējumu ir pieejama vienā failā. Mēs varam viegli atrast konkrētajā dienā klātesošo darbinieku skaitu, kā arī iegūt to darbinieku vārdus, kuri bija klāt konkrētajā dienā.
Koda skaidrojums
Sheet1.TextBox1.Value
Iepriekš minētais kods tiek izmantots, lai iegūtu vērtību tekstlodziņā “TextBox1” no lapas “Sheet1”.
Rež. (FolderPath & "*.xlsx")
Iepriekš minētais kods tiek izmantots, lai iegūtu faila nosaukumu, kuram ir faila paplašinājums “.xlsx”. Vairāku rakstzīmju faila nosaukumam esam izmantojuši aizstājējzīmi *.
Kamēr faila nosaukums ""
Skaits1 = skaitlis1 + 1
ReDim saglabā failu masīvu (no 1 līdz 1)
FileArray (Count1) = Faila nosaukums
FileName = Režisors ()
Wend
Iepriekš minētais kods tiek izmantots, lai iegūtu visu mapē esošo failu nosaukumus.
I = 1 uz UBound (FileArray)
Nākamais
Iepriekš minētais kods tiek izmantots, lai apskatītu visus mapē esošos failus.
Diapazons ("A1", šūnas (LastRow, 1)). Kopēt DestWB.ActiveSheet.Cells (LastDesRow, 1)
Iepriekš minētais kods tiek izmantots, lai ierakstu kopētu no pirmās kolonnas uz mērķa darbgrāmatu.
Diapazons ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopēt DestWB.ActiveSheet.Cells (LastDesRow, 1)
Iepriekš minētais kods tiek izmantots, lai kopētu visu ierakstu no aktīvās darbgrāmatas uz mērķa darbgrāmatu.
Lūdzu, sekojiet tālāk norādītajam kodam
Opcija Explicit Sub CopyingSingleColumnData () 'Deklarējošie mainīgie Dim FileName, FolderPath, FileArray (), FileName1 Kā virkne Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1 Atkārtotās slīpsvītras ievietošana mapes ceļā, ja trūkst slīpsvītras (\) Ja pareizi (FolderPath, 1) "\" Tad FolderPath = FolderPath & "\" Beigt, ja tiek meklēti Excel faili FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Looping caur visiem Excel failiem mapē FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 līdz Count1) FileArray (Count1) = FileName FileName = Dir () Wend' jaunas darbgrāmatas izveide Set DestWB = Workbooks.Add For i = 1 to UBound (FileArray) 'Pēdējās rindas atrašana darbgrāmatā LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Excel darbgrāmatas atvēršana Set SourceWB = Workbooks.Open [FolderPath & FileArray (i)] LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Kopēto datu ielīmēšana galamērķa darbgrāmatas pēdējā rindā If LastDesRow = 1 Tad' Pirmās kolonnas kopēšana uz galamērķa darbgrāmatas diapazona pēdējo rindu ("A1", šūnas (LastRow, 1)). ActiveSheet.Cells (LastDesRow, 1) Cits diapazons ("A1", šūnas (LastRow, 1)). Kopēt DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Beigt, ja SourceWB.Close False Next 'Saglabājot un aizverot jaunu Excel darbgrāmata DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nekas nenoteikts SourceWB = Nekas Beigt Sub Sub CopyingMultipleColumnData () 'Deklarējošie mainīgie Dim FileName, FolderPath, FileArray (), LastDarName1 , Count1, i Kā vesels skaitlis Dim avotsWB, DestWB kā darbgrāmatas lietojumprogramma.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Ievietojot slīpsvītru mapes ceļā, ja trūkst slīpsvītras (\) Ja ir labi (FolderPath, 1) "\" Tad FolderPath = FolderPath & "\" End If 'Excel failu meklēšana FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Cilpu pārmeklēšana visiem mapē esošajiem Excel failiem, kamēr FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' jaunas darbgrāmatas izveide Set DestWB = Workbooks.Add I = 1 uz UBound (FileArray) 'Pēdējās rindas atrašana darbgrāmatā LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row "Excel darbgrāmatas atvēršana Set SourceWB = Workbooks.Open (FolderPath & FileArray (i)) 'Kopēto datu ielīmēšana galamērķa darbgrāmatas pēdējā rindā If LastDesRow = 1 Tad' Visu darblapā esošo datu kopēšana uz galamērķa darbgrāmatas diapazona pēdējo rindu ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopēt DestWB.ActiveSheet.Cells (LastDesRow, 1) Cits diapazons ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell))). Kopēt DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Beigt, ja SourceWB.Close False Next 'Saglabāšana un aizvēršana jauna Excel darbgrāmata DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nekas nav iestatīts avotsWB = Nekas Beigu apakš
Ja jums patika šis emuārs, kopīgojiet to ar saviem draugiem Facebook. Varat arī sekot mums Twitter un Facebook.
Mēs labprāt uzklausītu jūsu viedokli, dariet mums zināmu, kā mēs varam uzlabot savu darbu un padarīt to labāku jums. Rakstiet mums e -pasta vietnē