Excel - makro uute töövihikute loomiseks ja andmete kopeerimiseks
Probleem
Otsin makrorežiimi, et kopeerida ridasid veeru osalise rakusisalduse alusel. Mul on Exceli tabel nimega "arc.xlsx", millest sooviksin teatud kriteeriumide täitmisel kopeerida andmeid mõnele muule uuele Exceli failile. Exceli faili sisaldav asukoht on C: dokumendid ja sätted xxxx Desktop Company. Olen ainult algaja Excelis.
Allpool on näide arc.xlsx
GP BR CUST_NO CUST_NAME päev mo aasta I1 01 999999 SMITH 00 08 09 I1 ab 999999 SMITH 04 08 09 I1 cd 999999 SMITH 04 10 09 I1 01 999999 SMITH 04 01 10 I1 02 999999 SMITH 27 02 10 I1 01 999999 SMITH 27 02 10 I1 01 999999 cd 999999 SMITH 02 03 10 I1 cd 999999 SMITH 04 03 10 I1 cd 999999 SMITH 30 07 09 I1 ab 999999 SMITH 30 07 09 I1 02 999999 SMITH 30 07 09
- Tahaksin, et makro kopeeriks ridu, millel on veerus B "ab" (pealkiri BR), ja salvestage see uude Exceli faili nimega ab.xlsx samas asukohakaustas.
- Salvestades sama faili nimega cd.xlsx, 01.xlsx nii edasi, salvestage need ka "cd", "01" ja "02".
Lahendus
1. TÖÖ TEIE TÖÖKIRI
2. Avage tööraamat
3. Vajutage ALT + F11 (nii ALT-klahv kui ka F11-klahv korraga). See avatud VBE
4. Klõpsake VBE menüüst suvandil Insert ja seejärel klõpsates nuppu Module. See avab tühja mooduli
5. Kopeeri kood pärast juhiseid, valides koodi (leitakse pärast juhiseid) ja vajutades CTRL + C (mõlemad klahvid korraga)
6. Kleepige kood äsja lisatud moodulisse (vt 4. samm), klõpsates moodulil ja vajutades CTRL + V (mõlemad korraga)
7. Veenduge, et kleebitud koodis ei oleks punast joont.
8. Makro käivitamiseks vajutage nuppu F5.
9 Kontrollige vaikimisi valitud dokumente, kus fail üldiselt salvestatakse.
SIIT ON KOOD
Alamandmed () Dim thisWB Nagu String Dim newWB Nagu String thisWB = ActiveWorkbook.Name On Error Jätka Järgmised lehed ("tempsheet"). Delete On Error GoTo 0 Sheets.Add ActiveSheet.Name = "tempsheet" lehed ("Sheet1"). Valige Kui ActiveSheet.AutoFilterMode Seejärel Cells.Select On Error Jätka Next ActiveSheet.ShowAllData On Error GoTo 0 Lõpeta, kui veerud ("B: B"). Valige Selection.Copy Sheets ("Tempsheet"). Valige Range ("A1"). Valige ActiveSheet.Paste Application.CutCopyMode = False If (Cells (1, 1) = "") Siis lastrow = Cells (1, 1) .End (xlDown) .Row Kui lastrow Rows.Count Seejärel Range ("A1: A" & lastrow - 1) .Select Selection.Delete Shift: = xlUp Lõpeta, kui veerud ("A: A"). Valige veerud ("A: A"). AdvancedFilter Action: = xlFilterCopy, _ CopyToRange: = Range (" B1 "), unikaalne: = tõelised veerud (" A: A "). Kustutage lahtrid.Valige valik.Sort _ Key1: = vahemik (" A2 "), järjekorras1: = xlAscending, _ päis: = xlYes, tellimuskohandatud: = 1, _ MatchCase: = False, Orientation: = xlTopToBottom, _ DataOption1: = xlSortNormal lMaxSupp = Rakud (read.Count, 1) .End (xlUp). uppno = 2 lMaxSupp Windowsile (thisWB) .Aktive supName = lehed ("tempsheet"). Range ("A" ja suppno) Kui supName "" siis "Workbooks." Lisa ActiveWorkbook.SaveAs supName newWB = ActiveWorkbook.Name Windows (thisWB). Aktiveerige lehed ("Sheet1") Valige lahtrid.Vali kui ActiveSheet.AutoFilterMode = False ja seejärel valimine.AutoFilter End Kui valik.AutoFilter väli: = 2, kriteeriumid1: = "=" & supName, _ Operaator: = xlAnd, kriteeriumid2: = "" Lastrow = Rakud (read.Count, 2) .End (xlUp) .Rida read ("1:" & lastrow) .Kopeeri Windows (newWB). Aktiveeri ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close End Kui järgmised lehed ( Kustutage lehed ("Sheet1"). Valige If ActiveSheet.AutoFilterMode Seejärel lahtrid.Valige ActiveSheet.ShowAllData lõpp, kui lõppu Tänu Rizvisale1 selle näpunäite eest.