Excel - makro, joka luo uuden työkirjan ja kopioi tiedot
Ongelma
Etsin makroja kopioimaan rivejä sarakkeen osittaisen solun sisällön perusteella. Minulla on Excel-taulukko, jota kutsutaan nimellä "arc.xlsx", josta haluan kopioida tietoja muutamiin uusiin Excel-tiedostoihin, kun tietyt kriteerit täyttyvät. Excel-tiedoston sisältämä sijainti on C: Dokumentit ja asetukset xxxx Desktop Company. Olen vain aloittelija Excelissä.
Alla on esimerkki kaaresta .xlsx
GP BR CUST_NO CUST_NAME päivä mo vuosi 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
- Haluaisin, että makro kopioi rivit, joilla on sarakkeessa B ab-merkintä (otsikko BR), ja tallenna se uuteen excel-tiedostoon, jossa on nimi ab.xlsx samassa sijaintikansiossa.
- Samoin "cd", "01" ja "02" tallentamalla tiedot tiedostoihin, joiden nimi on cd.xlsx, 01.xlsx niin edelleen.
Ratkaisu
1. VOITTAA TYÖSKENTÄT
2. Avaa työkirja
3. Paina ALT + F11 (sekä ALT- että F11-näppäintä samanaikaisesti). Tämä avoin VBE
4. Valitse VBE-valikosta Lisää ja valitse sitten Moduuli napsauttamalla sitä. Tämä avaa tyhjän moduulin
5. Kopioi koodi annettujen ohjeiden jälkeen valitsemalla koodi (löytyy ohjeiden jälkeen) ja painamalla CTRL + C (molemmat näppäimet samanaikaisesti)
6. Liitä koodi äskettäin lisättyyn moduuliin (katso vaihe 4) napsauttamalla moduulia ja painamalla CTRL + V (uudelleen molemmat samanaikaisesti)
7. Varmista, ettei liitetyssä koodissa ole punaista viivaa.
8. Suorita makro painamalla F5.
9 Tarkista asiakirjat oletussijainnissa, jossa yleensä on Excel.
TÄSTÄ ON KOODI
Alatiedot () Dim thisWB: n merkkijono Dim newWB: n merkkijono thisWB = ActiveWorkbook.Name On Error Jatka seuraavia arkkeja ("tempsheet"). Poista virheilmoitus GoTo 0 Sheets.Add ActiveSheet.Name = "tempsheet" Sheets ("Sheet1"). Valitse Jos ActiveSheet.AutoFilterMode sitten Cells.Select On Error Jatka Next ActiveSheet.ShowAllData On Error GoTo 0 Lopeta Jos sarakkeet ("B: B"). Valitse Selection.Copy Sheets ("tempsheet") Valitse Range ("A1"). Valitse ActiveSheet.Paste Application. & lastrow - 1) .Valitse valinta. Poista Shift: = xlUp Loppu Jos lopetat sarakkeet ("A: A"). Valitse sarakkeet ("A: A"). AdvancedFilterin toiminta: = xlFilterCopy, _ CopyToRange: = Range (" B1 "), Unique: = True Columns (" A: A "). Poista Cells.Select Selection.Sort _ Key1: = Range (" A2 "), Order1: = xlAscending, _ Header: = xlYes, OrderCustom: = 1, _ MatchCase: = False, Suunta: = xlTopToBottom, _ DataOption1: = xlSortNormal lMaxSupp = Solut (rivit.Luku, 1) .End (xlUp). uppno = 2 lMaxSupp Windows (thisWB) .Avaa supName = Sheets ("tempsheet"). Range ("A" & suppno) Jos supName "" sitten Workbooks.Add ActiveWorkbook.SaveAs supName newWB = ActiveWorkbook.Name Windows (thisWB). Aktivoi arkit ("Sheet1") Valitse solut.Valitse Jos ActiveSheet.AutoFilterMode = False sitten valinta.AutoFilter End Jos valinta.AutoFilter Field: = 2, kriteerit1: = "=" & supName, _ Operaattori: = xlAnd, kriteerit2: = "" Lastrow = Solut (rivit.Luku, 2) .End (xlUp) .Rivit rivit ("1:" & lastrow) .Kopioi Windows (newWB) .Aktivoi ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close End Jos seuraava arkki ( "Tempsheet"). Poista arkit ("Sheet1") Valitse Jos ActiveSheet.AutoFilterMode sitten solut.Valitse ActiveSheet.ShowAllData End Jos lopetat Kiitos Rizvisa1: lle tästä vinkistä.