Tässä artikkelissa luomme makron, joka kopioi tiedot kansion useista työkirjoista uuteen työkirjaan.
Luomme kaksi makroa; yksi makro kopioi tietueet vain ensimmäisestä sarakkeesta uuteen työkirjaan ja toinen makro kopioi kaikki tiedot siihen.
Tämän esimerkin raakatiedot koostuvat työntekijöiden läsnäolotiedoista. TestFolderissa on useita Excel -tiedostoja. Excel -tiedostojen tiedostonimet edustavat tiettyä päivämäärää ddmmyyyy -muodossa.
Jokainen Excel -tiedosto sisältää päivämäärän, työntekijän tunnuksen ja työntekijöiden nimen, jotka olivat läsnä kyseisenä päivänä.
Olemme luoneet kaksi makroa; "CopyingSingleColumnData" ja "CopyingMultipleColumnData". "CopyingSingleColumnData" -makro kopioi tietueet vain kaikkien kansion tiedostojen ensimmäisestä sarakkeesta uuteen työkirjaan. "CopyingMultipleColumnData" -makro kopioi kaikki tiedot kaikista kansion tiedostoista uuteen työkirjaan.
"CopyingSingleColumnData" -makro voidaan suorittaa napsauttamalla "Copying Single Column" -painiketta. "CopyingMultipleColumnData" -makro voidaan suorittaa napsauttamalla "Kopioi useita sarakkeita" -painiketta.
Ennen makron suorittamista on määritettävä kansion polku tekstikenttään, johon Excel -tiedostot sijoitetaan.
Kun "Kopioi yksi sarake" -painiketta napsautetaan, määritettyyn kansioon luodaan uusi työkirja "ConsolidatedFile", joka sisältää konsolidoidut tiedot kansion kaikkien tiedostojen ensimmäisestä sarakkeesta.
Uusi työkirja sisältää vain tietueet ensimmäisessä sarakkeessa. Kun meillä on konsolidoidut tiedot, voimme selvittää tietyn päivän läsnä olevien työntekijöiden määrän laskemalla päivämäärän. Tietyn päivämäärän lukumäärä on sama kuin kyseisenä päivänä läsnä olevien työntekijöiden määrä.
Kun "Kopioi useita sarakkeita" -painiketta napsautetaan, se luo määritettyyn kansioon uuden työkirjan "ConsolidatedAllColumns". Tämä työkirja sisältää yhdistettyjä tietoja kaikista kansion kaikkien tiedostojen tietueista.
Uusi luotu työkirja sisältää kaikki tietueet kaikista kansion tiedostoista. Kun olemme saaneet yhdistetyt tiedot, meillä on kaikki läsnäolotiedot saatavilla yhdessä tiedostossa. Voimme helposti löytää kyseisenä päivänä läsnä olevien työntekijöiden määrän ja saada myös kyseisenä päivänä läsnä olevien työntekijöiden nimet.
Koodin selitys
Sheet1.TextBox1.Value
Yllä olevaa koodia käytetään arvon lisäämiseen tekstikenttään "TextBox1" taulukosta "Sheet1".
Ohjaus (FolderPath & "*.xlsx")
Yllä olevaa koodia käytetään tiedoston nimen saamiseen, jonka tiedostopääte on .xlsx. Olemme käyttäneet jokerimerkkiä * monen merkin tiedoston nimessä.
Vaikka tiedostonimi ""
Count1 = Count1 + 1
ReDim Säilytä FileArray (1 laskea1)
FileArray (Count1) = Tiedostonimi
Tiedostonimi = Ohjaus ()
Lähteä
Yllä olevaa koodia käytetään hakemaan kaikkien kansion tiedostojen tiedostonimet.
I = 1 UBoundiin (FileArray)
Seuraava
Yllä olevaa koodia käytetään kaikkien kansion tiedostojen selaamiseen.
Alue ("A1", solut (LastRow, 1)). Kopioi DestWB.ActiveSheet.Cells (LastDesRow, 1)
Yllä olevaa koodia käytetään tietueen kopioimiseen ensimmäisestä sarakkeesta kohdekirjaan.
Alue ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopioi DestWB.ActiveSheet.Cells (LastDesRow, 1)
Yllä olevaa koodia käytetään kaikkien tietueiden kopioimiseen aktiivisesta työkirjasta kohdekirjaan.
Seuraa koodia alla
Option Explicit Sub CopyingSingleColumnData () 'Ilmoittavat muuttujat Dim FileName, FolderPath, FileArray (), FileName1 String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1 Lisää vinoviiva kansion polkuun, jos vinoviiva (\) puuttuu Jos oikea (FolderPath, 1) "\" Sitten FolderPath = FolderPath & "\" Lopeta, jos etsit Excel -tiedostoja FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Selaa kaikkia Excel -tiedostoja kansiossa FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Uuden työkirjan luominen Aseta DestWB = Työkirjat.Add For i = 1 to UBound (FileArray) 'Työkirjan viimeisen rivin löytäminen LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Excel -työkirjan avaaminen Aseta lähdeWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Kopioitujen tietojen liittäminen kohdekirjan viimeiselle riville If LastDesRow = 1 Sitten' Kopioi ensimmäinen sarake viimeiselle riville kohdetyökirjan alueella ("A1", Solut (LastRow, 1)). Copy DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Solut (LastRow, 1)). Kopioi DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Tallentaa ja sulkea uusi Excel työkirja DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData () 'Declaring muuttujat Dim FileName, FolderPath, FileArray (), LastDameRow1 , Count1, i Kokonaislukuna Dim LähdeWB, DestWB Työkirjasovelluksena.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Viistoviivan lisääminen kansion polkuun, jos vinoviiva (\) puuttuu Jos oikea (FolderPath, 1) "\" Sitten FolderPath = FolderPath & "\" End If 'Excel -tiedostojen etsiminen FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 "Selaa kaikkia kansion Excel -tiedostoja Tiedostonimi" "Count1 = Count1 + 1 ReDim Preserve FileArray (1 to Count1) FileArray (Count1) = FileName FileName = Dir () Wend 'Uuden työkirjan luominen Aseta DestWB = Workbooks.Add I = 1 UBoundille (FileArray) 'Työkirjan viimeisen rivin löytäminen LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Excel -työkirjan avaaminen Aseta lähdeWB = Workbooks.Open (FolderPath & FileArray (i)) 'Kopioitujen tietojen liittäminen kohdetyökirjan viimeiselle riville If LastDesRow = 1 Sitten' Kaikkien laskentataulukon tietojen kopioiminen kohdekirjan alueen viimeiselle riville ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopioi DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell))). Kopioi DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Tallennus ja sulkeminen uusi Excel -työkirja DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Ei mitään Aseta lähdeWB = Ei mitään Lopeta ala
Jos pidit tästä blogista, jaa se ystävillesi Facebookissa. Voit myös seurata meitä Twitterissä ja Facebookissa.
Haluaisimme kuulla sinusta, kerro meille, kuinka voimme parantaa työtämme ja parantaa sitä sinulle. Kirjoita meille sähköpostitse