Excel - makro, lai izveidotu jaunu darbgrāmatu un kopētu datus
Izdevums
Es meklēju makro, lai kopētu rindas, pamatojoties uz kolonnas daļēju šūnu saturu. Man ir Excel izklājlapa, ko sauc par "arc.xlsx", no kuras es vēlētos kopēt datus uz pārējiem jauniem Excel failiem, ja ir izpildīti noteikti kritēriji. Excel faila atrašanās vieta ir C: Dokumenti un iestatījumi xx Desktop Company. Esmu tikai Excel iesācējs.
Zemāk ir parādīts loka.xlsx paraugs
GP BR CUST_NO CUST_NAME diena - gads 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
- Es gribētu, lai makro kopētu rindas, kurām B slejā ir “ab” (ar nosaukumu BR), un saglabājiet to jaunā Excel failā ar nosaukumu ab.xlsx tajā pašā atrašanās vietas mapē.
- Un tas pats “cd”, “01” un “02”, saglabājot datus failos ar nosaukumu cd.xlsx, 01.xlsx tā tālāk.
Risinājums
1. IZMANTOJIET DARBA GRĀMATU
2. Atveriet darba grāmatu
3. Nospiediet ALT + F11 (gan ALT taustiņu, gan F11 taustiņu vienlaicīgi). Šis atvērtais VBE
4. No VBE izvēlnes noklikšķiniet uz Ievietot un pēc tam izvēlieties moduli, noklikšķinot uz tā. Tas atvērs tukšu moduli
5. Kopējiet kodu pēc norādījumiem, izvēloties kodu (atrodams pēc instrukcijām) un nospiežot CTRL + C (abi taustiņi vienlaicīgi)
6. Ielīmējiet kodu jaunizveidotajā modulī (skatiet 4. soli), noklikšķinot uz moduļa un nospiežot CTRL + V (atkal abi vienlaicīgi)
7. Pārliecinieties, vai ielīmētajā kodā nav sarkanas līnijas.
8. Nospiediet F5, lai palaistu makro.
9 Pārbaudiet dokumentus noklusējuma vietā, kur parasti Excel saglabā failu.
ŠEIT IR KODS
Apakšdati () Dim thisWB Kā virkne Dim newWB Kā String thisWB = ActiveWorkbook.Name On Error Atjaunot nākamās lapas ("tempsheet") Dzēst On Error GoTo 0 Sheets.Add ActiveSheet.Name = "tempsheet" Lapas ("Sheet1"). Izvēlieties Ja ActiveSheet.AutoFilterMode Tad Cells.Select On Error Atjaunot Next ActiveSheet.ShowAllData On Error GoTo 0 Beigt Ja kolonnas ("B: B") Izvēlieties Selection.Copy Sheets ("Tempsheet") Izvēlieties Range ("A1"). Atlasiet ActiveSheet.Paste Application.CutCopyMode = False If (Cells (1, 1) = "") Tad Lastrow = Šūnas (1, 1) .End (xlDown). Rinda Ja pēdējās rindas.Skaitīšana Tad diapazons ("A1: A" & lastrow - 1) .Select Selection.Delete Shift: = xlUp beigas, ja beigas, ja kolonnas ("A: A"). Izvēlieties kolonnas ("A: A"). AdvancedFilter darbība: = xlFilterCopy, _ CopyToRange: = Range (" B1 "), Unique: = True kolonnas (" A: A ") Dzēst Cells.Select Selection.Sort _ Key1: = Range (" A2 "), Order1: = xlAscending, _ Header: = xlYes, OrderCustom: = 1, _ MatchCase: = False, Orientācija: = xlTopToBottom, _ DataOption1: = xlSortNormal lMaxSupp = Šūnas (rindas.Skaitlis, 1) .End (xlUp). uppno = 2 lMaxSupp Windows (thisWB) .Aktivizējiet supName = lapas ("tempsheet"). Range ("A" un suppno) Ja supName "" tad darbgrāmatas. Pievienojiet ActiveWorkbook.SaveAs supName newWB = ActiveWorkbook.Name Windows (thisWB). Aktivizējiet lapas ("Sheet1") Izvēlieties Cells.Select If ActiveSheet.AutoFilterMode = False Tad Selection.AutoFilter End Ja Selection.AutoFilter lauks: = 2, kritēriji1: = "=" & supName, _ Operators: = xlAnd, kritēriji2: = "" lastrow = šūnas (rindas.Skaitlis, 2) .Tālāk (xlUp). Rindu rindas ("1:" & lastrow). Kopēt Windows (newWB). Aktivizējiet ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close End Ja nākamās lapas ( Dzēst lapas ("Sheet1") Izvēlieties If ActiveSheet.AutoFilterMode Tad Cells.Select ActiveSheet.ShowAllData beigas, ja beigas Paldies Rizvisa1 par šo padomu.