แสดงกระทู้
1
ห้องสนทนาทั่วไป / vba excel แยก sheet ตามกลุ่มข้อมูลอัตโนมัติ
« เมื่อ: 16 ก.พ. 64 , 06:27:03 »
สวัสดีครับ อจ ทุกท่าน
ผมทำการแยก sheet ด้วย vba excel
ตามกลุ่มของข้อมูลที่เหมือนกัน
มันก็ทำงานได้ปกติ.,.ครับ
ปัญกาของผมคือ ผมจะต้องมาจัดรูปแบบต่างๆ รวมถึงจัดหน้ากระดาษใหม่ครับ
ถ้าอย่างที่ผมคิดไว้คือ สร้าง sheet
ต้นแบบไว้ แล้วค่อยเอาข้อมูลมาหยอด
จะได้หรือเปล่า และจะต้องแก้ code อย่างไรครับ ผมรบกวนด้วยครับ
ผมทำการแยก sheet ด้วย vba excel
ตามกลุ่มของข้อมูลที่เหมือนกัน
มันก็ทำงานได้ปกติ.,.ครับ
ปัญกาของผมคือ ผมจะต้องมาจัดรูปแบบต่างๆ รวมถึงจัดหน้ากระดาษใหม่ครับ
ถ้าอย่างที่ผมคิดไว้คือ สร้าง sheet
ต้นแบบไว้ แล้วค่อยเอาข้อมูลมาหยอด
จะได้หรือเปล่า และจะต้องแก้ code อย่างไรครับ ผมรบกวนด้วยครับ
โค๊ด: [Select]
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
