Results 1 to 4 of 4

Thread: EXCEL 2010

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Registered 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

  2. #2
    Registered User hateras's Avatar
    Join Date: Jan:2011
    Location: Kronos III
    Posts: 1,028
    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 Sub
    Last 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

  3. #3
    Registered 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

  4. #4
    Registered User hateras's Avatar
    Join Date: Jan:2011
    Location: Kronos III
    Posts: 1,028
    ,
    ASRock B550M Pro 4; Ryzen R5 3600; 2x16 GiB G.SKILL Aegis 3200; 1TB Samsung QVO 960 + 3TB Seagate IronWolf; Zalman Z1

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Copyright © 1999-2011 . .
iskamPC.com | mobility.BG | Bloody's Techblog | | 3D Vision Blog |