Federer 發問時間: 電腦與網際網路軟體 · 1 0 年前

EXCEL VBA新增SHEET的問題!

請問如我有以下的資料,而我想要以不同的Family的名字,開不同的sheet,如果family是空白的,就把其資料放到同一個sheet,如最下面!請問各位大大這樣vba要如何寫呢?另外是否可以將新開的sheet放到後面,也就是按開的順序去排sheet?謝謝您!

Family分格線Billing DEVICE

CT123---------2B5MNOPQ14F

CT123---------215IJKLMN14FGS

CT124---------2B5MNOPQ14F

CT124---------2B5MNOPQ14F

CT123---------2A5TUVWXY14FG

CT124---------2W5MNOPQ14F

CT125---------215IJKLMN14FGS

CT124---------2D5MNOPQ14F01

空白---------2W5MNOPQ14F

CT123---------2D5MNOPQ14F01

CT124---------215TUVWXY13FGS

CT124---------215TUVWXY13FGS

空白---------215IJKLMN14FGs

CT125---------2B5MNOPQ14F

空白---------2A5TUVWXY14FG

CT125---------2W5MNOPQ14F

CT125---------215IJKLMN14FG

空白---------2B5MNOPQ14F

CT125---------215IJKLMN14FGS

空白---------2B5MNOPQ13F

空白---------2B5MNOPQ13F

CT123---------2D5MNOPQ14F01

空白---------215IJKLMN14FGS

---------------------------------------------------------想得到的樣子

sheetname:CT123

CT123---------2B5MNOPQ14F

CT123---------215IJKLMN14FGS

CT123---------2A5TUVWXY14FG

CT123---------2D5MNOPQ14F01

CT123---------2D5MNOPQ14F01

SHEETNAME:CT124

CT124---------2B5MNOPQ14F

CT124---------2B5MNOPQ14F

CT124---------2W5MNOPQ14F

CT124---------2D5MNOPQ14F01

CT124---------215TUVWXY13FGS

CT124---------215TUVWXY13FGS

sheetname:CT125

CT125---------215IJKLMN14FGS

CT125---------2B5MNOPQ14F

CT125---------2W5MNOPQ14F

CT125---------215IJKLMN14FG

CT125---------215IJKLMN14FGS

sheetname:其它(ps:放family是空白的)

空白---------2W5MNOPQ14F

空白---------215IJKLMN14FGs

空白---------2A5TUVWXY14FG

空白---------2B5MNOPQ14F

空白---------2B5MNOPQ13F

空白---------2B5MNOPQ13F

空白---------215IJKLMN14FGS

已更新項目:

是在a和b欄,謝謝您!

3 個解答

評分
  • 1 0 年前
    最佳解答

    AB1FamilyBilling DEVICE2CT1232B5MNOPQ14F3CT123215IJKLMN14FGS4CT1242B5MNOPQ14F5CT1242B5MNOPQ14F6CT1232A5TUVWXY14FG7CT1242W5MNOPQ14F8CT125215IJKLMN14FGS9CT1242D5MNOPQ14F0110 2W5MNOPQ14F11CT1232D5MNOPQ14F0112CT124215TUVWXY13FGS13CT124215TUVWXY13FGS14 215IJKLMN14FGs15CT1252B5MNOPQ14F16 2A5TUVWXY14FG17CT1252W5MNOPQ14F18CT125215IJKLMN14FG19 2B5MNOPQ14F20CT125215IJKLMN14FGS21 2B5MNOPQ13F22 2B5MNOPQ13F23CT1232D5MNOPQ14F0124 215IJKLMN14FGS假設你的表格如同上面的樣子, 並且放在SHEET1上VBA可以寫成下面的樣子Sub test()    For i = 2 To 24  '資料數        If Sheets("sheet1").Cells(i, 1) = "" Then            st = "其他"        Else            st = Cells(i, 1)        End If        '若沒有這個名稱的工作頁, 就新增它, 並放在最後        On Error GoTo ErrorHandler        '將值放入該頁旳最後一筆        Worksheets(st).Range("f1") = "=counta(a:a)"        m_count = Worksheets(st).Range("f1").Value + 1        Worksheets(st).Cells(m_count, 1) = st        Worksheets(st).Cells(m_count, 2) = Sheets("sheet1").Cells(i, 2)            Next i    Exit SubErrorHandler:    m_count = Worksheets.Count    Worksheets.Add after:=Worksheets(m_count)    ActiveSheet.Name = st    ResumeEnd Sub有一點要注意的是, 程式如想要重跑, 請刪掉sheet1以外的工作頁,否則資料會重複複製

  • 1 0 年前

    自動刪除新增更新工作表,編程如下:

    Sub 按鈕1_Click()

    Dim mySht As Worksheet

    '''更新資料時,自動刪除工作表

    On Error Resume Next

    Do

    Set mySht = Worksheets(2)

    Application.DisplayAlerts = False

    mySht.Delete

    Application.DisplayAlerts = True

    Loop Until Sheets.Count = 1

    sheets_no = Sheet1.Cells(2, 4)

    For i = 1 To sheets_no

    kk = 1

    jj = 1

    '''更新資料時,自動新增工作表

    With Worksheets

    .Add After:=.Item(.Count) '新增在最後面

    End With

    XSht_name = Sheet1.Cells(i + 1, 3)

    ActiveSheet.Name = XSht_name

    Columns("A:A").Select

    Selection.ColumnWidth = 8.5

    Columns("B:B").Select

    Selection.ColumnWidth = 20

    Cells(1.1).Select

    Cells(1, 1) = "Family": Cells(1, 2) = "Billing DEVICE"

    '''copy各工作表之資料

    Do

    kk = kk + 1

    Sht1_Family = Sheet1.Cells(kk, 1).Value

    Sht1_Billing = Sheet1.Cells(kk, 2).Value

    If Sht1_Family = XSht_name Then

    jj = jj + 1

    ActiveSheet.Cells(jj, 1) = Sht1_Family

    ActiveSheet.Cells(jj, 2) = Sht1_Billing

    End If

    Loop Until Sht1_Family = ""

    Next i

    End Sub

    下載參考:

    http://www.freewebtown.com/scliang/Excel/SHEET_DAT...

  • 1 0 年前

    Family 和Billing DEVICE是在A及C欄嗎?

還有問題?馬上發問,尋求解答。