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
4Case: 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