vba excel แยก sheet ตามกลุ่มข้อมูลอัตโนมัติ



0 สมาชิก และ 1 บุคคลทั่วไป กำลังดูหัวข้อนี้

16 ก.พ. 64 , 06:27:03
อ่าน 394 ครั้ง

napat2020

  • สมาชิกไท.Access
  • กระทู้: 16

  • ขอบคุณ ไท.Access

    • ดูรายละเอียด

สวัสดีครับ อจ ทุกท่าน
ผมทำการแยก sheet ด้วย vba excel
ตามกลุ่มของข้อมูลที่เหมือนกัน
มันก็ทำงานได้ปกติ.,.ครับ
 ปัญกาของผมคือ ผมจะต้องมาจัดรูปแบบต่างๆ รวมถึงจัดหน้ากระดาษใหม่ครับ
ถ้าอย่างที่ผมคิดไว้คือ สร้าง sheet
ต้นแบบไว้ แล้วค่อยเอาข้อมูลมาหยอด
จะได้หรือเปล่า และจะต้องแก้ code อย่างไรครับ ผมรบกวนด้วยครับ


 

 

Sub SpiltSheet()

On Error Resume Next

'Declaring Constant Variable
 

Application.DisplayAlerts = False

 

Const col = "A"

Const header_row = ("1:1")

Const starting_row = 2

Dim Source_sheet As Worksheet

Dim destination_sheet As Worksheet

Dim current_sheet As Worksheet

Dim footer_sheet As Worksheet

Dim source_row As Long

Dim last_row As Long

Dim destination_row As Long

Dim Maker As String

'Set source_sheet = ActiveSheet

Set Source_sheet = Sheets("Base")

Set footer_sheet = Sheets("Footer")

 

    last_row = Source_sheet.Cells(Source_sheet.Rows.Count, col).End(xlUp).Row

 

    For source_row = starting_row To last_row

    Maker = Source_sheet.Cells(source_row, col).Value

 

    Set destination_sheet = Nothing

    On Error Resume Next

    Set destination_sheet = Worksheets(Maker)

   

    On Error GoTo 0

   

    If destination_sheet Is Nothing Then

        Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))

        destination_sheet.Name = Maker

   

        'Header

        Source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)

 

    End If

   

    ' Retrive data

    destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1

    Source_sheet.Rows(source_row).Copy Destination:=destination_sheet.Rows(destination_row)

 

    Next source_row


End Sub



 


บอร์ดเรียนรู้ Access สำหรับคนไทย



There are no comments for this topic. Do you want to be the first?