Results 1 to 4 of 4
Thread: ïîìîù îòíîñíî EXCEL 2010
Hybrid View
-
26th April 2013 20:33 #1Registered User
Join Date: Aug:2005
Location: Bugaria
Posts: 652
ïîìîù îòíîñíî EXCEL 2010
Çäðàâåéòå,
Èìà ëè âúçìîæíîñò äà íàïðàâÿ ñëåäíîòî íåùî?
Èìàì åäèí øèéò ñ ìíîãî äàííè, ùå ñîðòèðàì ïî êîëîíà À ,è íàâñÿêúäå êúäåòî èìàì åäíàêâè ñòîéíîñò â êîëîíà À äà ñå ãåíåðèðà àâòîìàòè÷íî íîâ ôàéë(ïî âúçìîæíîñò ÊÌË, íî ìîæå è csv).Òðÿáâà èìåòî íà ôàéëà äà áúäå êàêâàòî ñòîéíîñò å â êîëîíà À.
Ïðèìåð:
1 äàííè
1 äàííè
1 äàííè
1 äàííè
1 äàííè
1 äàííè
2 äàííè
2 äàííè
2 äàííè
2 äàííè
2 äàííè
2 äàííè
3 äàííè
3 äàííè
3 äàííè
3 äàííè
3 äàííè
3 äàííè
4 äàííè
4 äàííè
4 äàííè
4 äàííè
4 äàííèCase: Lancool-215 /MB: Asus Prime B450- Plus/CPU: AMD Ryzan 5800X3D /GeForce RTX™ 4090 GAMING OC / PSU: Super Flower Leadex III 750W /2x16GB DDR4 3600 Kingston FURY/LG 27GL850-B/TV LG OLED 55B9 / VR: HP Reverb 2
-
28th April 2013 15:17 #2
Äàííèòå îò ñòðàíèöà 1, êîëîíà À îò ðåä 1 äî êúäåòî èìà äàííè /ïúðâà ïðàçíà êëåòêà â êîëîíà À/ ñå êîïèðàò â íîâ workbook êîéòî ñå çàïèñâà êàòî XLS ôàéë /îôèñ 1997 - 2003 ôîðìàò/.
Ðåäîâåòå ñå îáõîæäàò ïàê äî êúäåòî èìà äàííè /ïúðâàòà ïðàçíà êëåòêà íà ðåäà/. Ò.å. ìîæå äà èìà ðåäîâå ñ ðàçëè÷íà äúëæèíà.
Àêî äàííèòå íå ñà ñîðòèðàíè ïî êîëîíà À, èëè êîëîíàòà ñúäúðæà íåùà êîèòî íå ñà ãîäíè çà èìå íà ôàéë ïðåäïîëàãàì ùå ñòàíå ìàçàëî. Èìàé ãðèæàòà äà ñè ñðåøåø äàííèòå, ïëñ :-P
Edit: Ñìåíè "Sheet1" ñ èìåòî íà øèèòà îò êîéòî ùå ñå âçèìàò äàííèòå!
Code:Sub DataExport() Dim NewWB As Workbook Dim NewWS As Worksheet Dim OldWB As Workbook Dim OldWS As Worksheet Dim colctr1, colctr2 As Integer Set OldWB = ActiveWorkbook 'replace "Sheet1" with appropriate value! Set OldWS = OldWB.Worksheets("Sheet1") Set NewWB = Workbooks.Add Set NewWS = NewWB.Worksheets.Add currentcat = "" colctr1 = 1 a1cat = Trim(CStr(OldWS.Cells(colctr1, 1))) While a1cat <> "" If a1cat <> currentcat Then If currentcat <> "" Then 'store data from the current temp_sheet NewWB.SaveAs OldWB.Path + "\" + currentcat, xlAddIn8 'clear tmp_sheet NewWS.Cells.Clear End If currentcat = a1cat NewWS.Name = currentcat colctr2 = 1 End If NewWS.Cells(colctr2, 1) = a1cat 'copy remaining rows too rc = 2 rw = Trim(CStr(OldWS.Cells(colctr1, rc))) While rw <> "" NewWS.Cells(colctr2, rc) = rw rc = rc + 1 rw = Trim(CStr(OldWS.Cells(colctr1, rc))) Wend colctr2 = colctr2 + 1 colctr1 = colctr1 + 1 a1cat = Trim(CStr(OldWS.Cells(colctr1, 1))) Wend 'last data group If currentcat <> "" Then 'store data from the current temp_sheet NewWB.SaveAs OldWB.Path + "\" + currentcat, xlAddIn8 End If NewWB.Close False End SubLast edited by hateras; 28th April 2013 at 16:20.
ASRock B550M Pro 4; Ryzen R5 3600; 2x16 GiB G.SKILL Aegis 3200; 1TB Samsung QVO 960 + 3TB Seagate IronWolf; Zalman Z1
-
30th April 2013 20:32 #3Registered User
Join Date: Aug:2005
Location: Bugaria
Posts: 652
Áëàãîäàðÿ òè, ñòðàõîòíà ðàáîòà ìè ñâúðøè.
Íå ìîæåø äà ñè ïðåäñòàâèø êîëêî ðàáîòà ìè ñïåñòè
Case: Lancool-215 /MB: Asus Prime B450- Plus/CPU: AMD Ryzan 5800X3D /GeForce RTX™ 4090 GAMING OC / PSU: Super Flower Leadex III 750W /2x16GB DDR4 3600 Kingston FURY/LG 27GL850-B/TV LG OLED 55B9 / VR: HP Reverb 2
-
30th April 2013 22:41 #4
Ìîãà, ìîãà
ASRock B550M Pro 4; Ryzen R5 3600; 2x16 GiB G.SKILL Aegis 3200; 1TB Samsung QVO 960 + 3TB Seagate IronWolf; Zalman Z1




Reply With Quote
Íå âúçìîæíîñò äà èçêëþ÷à êîìïþòúðà
7th May 2023, 16:02 in Îáù ôîðóì çà PC õàðäóåð