VBA : Add sheet, filter , filename

[Supachok]

เรียน ท่านอาจารย์และผู้รู้
ปล : ไม่มีความเข้าใจในการเขียน VBA มากเท่าไร

ผมกำลังใช้ VBA เพื่อเขียนให้ Excel ทำงานในการแยก sheet และ filter จาก sheet master plan
-- Add sheet ทำได้ แต่มี error ใน sheet สุดท้ายทำให้มี sheet ที่ไม่ต้องการออกมาแต่แก้ ด้วย On Error Resume Next แทน

Worksheets("data base").Select
Range("e1").Select
Application.ScreenUpdating = False
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
ActiveCell.Offset(1, 0).Select
Sheets.Add.Name = ActiveCell.Value
Loop


-- Filter ไม่สามารถเข้าใจ Marco code เพื่อนำไปประยุกต์ปรับแก้ไขได้ จึงเกิดปัญหา filename ในหัวข้อถัดไป
=FILTER('Master plan'!RC:R[38]C[13],'Master plan'!RC:R[38]C=RC[19])" <<< หากสามารถอธิบายหลักให้ผมเข้่าใจได้ R1C1 ช่วยแนะนำที่ครับจะนำไปปรับใช้

ActiveCell.Formula2R1C1 = _
"=FILTER('Master plan'!RC:R[38]C[13],'Master plan'!RC:R[38]C=RC[19])"


-- filename ใน Cell T1 หลังจาก run Code (add sheet) แล้วจะมี sheet สร้างใหม่ออกมา Sheet (Bank,chize,Jen)
Cell T1 =MID(CELL("filename"),FIND("]",CELL("filename"),1)+1,2222) >>> ผลลัพธ์คือทุก sheet ที่สร้างใหม่โดยการ run code ได้ชื่อเดียวกันหมด ทำให้ Criteria ที่ตั้งไว้ไม่ match ในการดึง filter มาแสดง

ActiveCell.Formula2R1C1 = _
"=MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,2222)"


สิ่งที่ต้องให้ช่วยเหลือแนะนำ
1 .Add sheet Do until empty Cell อย่างไรไม่ให้เกิด error หรือเมื่อเจอ Empty cell แล้วหรือหยุดทำการสร้าง sheet ใหม่ แล้วออกจาก loop
2. Filter สามารถเขียนแบบ VBA ได้อย่างไร เพราะ Code copy จาก marco
3. filename ปกติเคยพบปัญหานี้ ไม่รู้จะแก้อย่างไรให้ Cell แสดงชื่อถูกต้องตาม sheet แต่ละ sheet.

[snasui]

หากโพสต์แล้วไม่ต้องโพสต์ซ้ำ ที่โพสต์ไว้ผมลบไปแล้วครับ

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub Add_sheet()
'    On Error Resume Next
    Worksheets("data base").Select
    Range("e1").Select
    
    Application.ScreenUpdating = False
    Do While Not IsEmpty(ActiveCell.Offset(1, 0)) 'And IsEmpty(ActiveCell.Offset(1, 0))
        ActiveCell.Offset(1, 0).Select
        Sheets.Add.Name = ActiveCell.Value
        'create filename each sheet
          Range("T1").Select
        '    ActiveCell.Formula2R1C1 = _
                "=MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,2222)"
            Range("T1").Value = ActiveSheet.Name
          'create filter formula
          Range("a1").Select
        ActiveCell.Formula2R1C1 = _
            "=FILTER('Master plan'!RC:R[38]C[13],'Master plan'!RC:R[38]C=RC[19])"
        Worksheets("data base").Activate
    Loop
    Application.ScreenUpdating = False
End Sub

ระบบการอ้างอิงแบบ R1C1 คือการอ้างอิงบรรทัดและแถวโดยใช้เซลล์ที่ Active อยู่ ณ ปัจจุบันเป็นเกณฑ์ เช่น RC:R[38]C[13] หมายถึงช่วงเซลล์ มีขอบเขตจากเซลล์ปัจจุบันถึงบรรทัดที่ 38 ถัดไปด้านล่างและถึงคอลัมน์ที่ 13 ถัดไปด้านขวาจากเซลล์ปัจจุบัน

ตัวเลขในก้ามปูมีโอกาสที่จะเป็นลบได้ หากเป็นลบก็จะเป็นทิศทางตรงกันข้าม สิ่งสำคัญจะต้องทราบว่าเซลล์ปัจจุบันคือเซลล์ไหน ไม่เช่นนั้นข้อมูลมีโอกาสผิดพลาดได้มากครับ

[Supachok]

เรียน ท่านอาจารย์และผู้รู้

หลังจากสร้าง sheet เพิ่มมา 3 sheet แล้ว
- ย้ายตำแหน่ง sheet ให้เหมาะสม
- ต้องการลบ sheet หลังจาก sheet ที่ 2 เป็นต้นไป
ปัญหาตอนนี้คือ (ว่าจะถามใหม่แต่ปรับไปปรับมา ได้หมดแล้วครับ)
- Code ด้านล่าง ลบ 2 sheet และจากนั้น ไม่ออกจาก Loop ทำให้ Excel run code ไม่จบ(ค้าง)
- การลบไม่ต้องให้ Excel ถามว่าจะลบ sheet จริงหรือไม่ = Application.DisplayAlerts = False, True


Do
i = 3
i = i + 1

Sheets(i).Delete
Loop Until IsEmpty(Worksheets)


[Supachok]

ขอบคุณมากครับ ที่ทำให้ผมผ่านไปได้