Šiame straipsnyje sukursime makrokomandą, kad nukopijuotume duomenis iš kelių aplanke esančių darbaknygių į naują darbaknygę.
Mes sukursime dvi makrokomandas; viena makrokomanda kopijuos įrašus tik iš pirmo stulpelio į naują darbaknygę, o antroji - visus duomenis į ją.
Neapdorotus šio pavyzdžio duomenis sudaro darbuotojų lankomumo įrašai. „TestFolder“ turime kelis „Excel“ failus. „Excel“ failų failų pavadinimai reiškia tam tikrą datą „ddmmyyyy“ formatu.
Kiekviename „Excel“ faile yra tų darbuotojų, kurie dalyvavo tą dieną, data, darbuotojo ID ir darbuotojo vardas.
Mes sukūrėme dvi makrokomandas; „CopyingSingleColumnData“ ir „CopyingMultipleColumnData“. „CopyingSingleColumnData“ makrokomanda kopijuos įrašus tik iš pirmo aplanko visų failų stulpelio į naują darbaknygę. „CopyingMultipleColumnData“ makrokomanda nukopijuos visus duomenis iš visų aplanke esančių failų į naują darbaknygę.
„CopyingSingleColumnData“ makrokomandą galima vykdyti spustelėjus mygtuką „Kopijuojamas vienas stulpelis“. „CopyingMultipleColumnData“ makrokomandą galima vykdyti spustelėjus mygtuką „Kopijuoti kelis stulpelius“.
Prieš paleisdami makrokomandą, teksto laukelyje turite nurodyti aplanko kelią, kuriame yra „Excel“ failai.
Spustelėjus mygtuką „Kopijuoti vieną stulpelį“, apibrėžtame aplanke bus sukurta nauja darbo knyga „ConsolidatedFile“. Šioje darbaknygėje bus konsoliduoti duomenys iš visų aplanko failų pirmo stulpelio.
Naujoje darbaknygėje bus tik įrašai pirmajame stulpelyje. Gavę konsoliduotus duomenis, mes galime sužinoti darbuotojų, esančių konkrečią dieną, skaičių, skaičiuodami datos skaičių. Konkrečios datos skaičius bus lygus tą dieną buvusių darbuotojų skaičiui.
Spustelėjus mygtuką „Kopijuoti kelis stulpelius“, apibrėžtoje aplanke bus sukurta nauja darbaknygė „ConsolidatedAllColumns“. Šioje darbaknygėje bus konsoliduoti duomenys iš visų aplanke esančių failų įrašų.
Sukurtoje naujoje darbaknygėje bus visi įrašai iš visų aplanke esančių failų. Kai turėsime konsoliduotus duomenis, turėsime visą dalyvavimo informaciją viename faile. Mes galime lengvai rasti tą dieną dirbančių darbuotojų skaičių ir sužinoti darbuotojų, kurie dalyvavo tą dieną, pavardes.
Kodo paaiškinimas
Sheet1.TextBox1.Value
Viršuje esantis kodas naudojamas vertei įterpti į teksto laukelį „TextBox1“ iš lapo „Sheet1“.
Rež. (FolderPath & "*.xlsx")
Aukščiau pateiktas kodas naudojamas failo, kurio plėtinys yra „.xlsx“, pavadinimui gauti. Kelių simbolių failo pavadinimui naudojome pakaitos simbolius *.
Nors „FileName“ „“
Skaičius1 = skaičius1 + 1
„ReDim Preserve FileArray“ (nuo 1 iki 1)
FileArray (Count1) = Failo pavadinimas
FileName = Režisierius ()
Wend
Aukščiau pateiktas kodas naudojamas visų aplankų failų failų pavadinimams gauti.
Jei i = 1 į „UBound“ („FileArray“)
Kitas
Viršuje esantis kodas naudojamas norint peržiūrėti visus aplanko failus.
Diapazonas („A1“, langeliai (paskutinė eilutė, 1)). Kopijuoti DestWB.ActiveSheet.Cells (LastDesRow, 1)
Aukščiau pateiktas kodas naudojamas įrašui kopijuoti iš pirmo stulpelio į paskirties darbaknygę.
Diapazonas ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopijuoti DestWB.ActiveSheet.Cells (LastDesRow, 1)
Aukščiau pateiktas kodas naudojamas kopijuoti visą įrašą iš aktyvios darbaknygės į paskirties darbaknygę.
Sekite toliau pateiktą kodą
Parinktis „Explicit Sub CopyingSingleColumnData ()“ „Kintamųjų deklaravimas Dim FileName, FolderPath, FileArray (), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1 Sheet Įterpti atgalinį brūkšnį į aplanko kelią, jei trūksta pasvirojo brūkšnio (\) Jei teisinga (FolderPath, 1) "\" Tada FolderPath = FolderPath & "\" End If 'Ieškoma "Excel" failų FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Looping all the Excel files in the folder while FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Naujos darbaknygės kūrimas Nustatykite DestWB = Workbooks.Add For i = 1 to UBound (FileArray) 'Paskutinės darbaknygės eilutės radimas LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row "" Excel "darbaknygės rinkinio atidarymasWB = Workbooks.Open [FolderPath & FileArray (i)] LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Kopijuotų duomenų įklijavimas į paskutinę paskirties darbaknygės eilutę If LastDesRow = 1 Tada' Pirmojo stulpelio kopijavimas į paskutinę paskirties darbaknygės diapazono eilutę ("A1", langeliai (LastRow, 1)). Copy DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Copy DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Išsaugoti ir uždaryti naują "Excel" darbaknygė DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close rinkinys DestWB = Nieko nenustatytas šaltinisWB = Nothing End Sub Sub CopyingMultipleColumnData () 'Declaring kintamieji Dim FileName, FolderPath, FileArray (), LastReg.Reg. , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Įterpti atgalinį brūkšnį į aplanko kelią, jei trūksta pasvirojo brūkšnio (\) Jei teisinga (FolderPath, 1) "\" Tada FolderPath = FolderPath & "\" End If 'Ieškoma Excel failų FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 „Looping all the Excel files in the folder while FileName" "Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend 'Naujos darbaknygės kūrimas Nustatykite DestWB = Workbooks.Add „I = 1 To UBound“ („FileArray“) „Paskutinės darbaknygės eilutės radimas LastDesRow = DestWB.ActiveSheet.Range („ A1 “). SpecialCells (xlCellTypeLastCell) .Row“ „Excel“ darbaknygės rinkinio atidarymasWB = Workbooks.Open (FolderPath & FileArray (i)) 'Nukopijuotų duomenų įklijavimas į paskutinę paskirties darbaknygės eilutę If LastDesRow = 1 Tada' Visų darbalapio duomenų kopijavimas į paskutinę paskirties darbaknygės diapazono eilutę ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopijuoti DestWB.ActiveSheet.Cells (LastDesRow, 1) Kitas diapazonas ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell))). Kopijuoti DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Pabaiga Jei SourceWB.Close False Next 'Įrašymas ir uždarymas nauja „Excel“ darbaknygė DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close D rinkinys estWB = Nieko nenustatytas šaltinisWB = Nieko pabaigos sub
Jei jums patiko šis tinklaraštis, pasidalykite juo su draugais „Facebook“. Be to, mus galite sekti „Twitter“ ir „Facebook“.
Mes norėtume išgirsti jūsų nuomonę, praneškite mums, kaip galime pagerinti savo darbą ir padaryti jį geresnį. Rašykite mums el