กาน Format ตารางข้อมูนด้วย VBA

[วังวู ช่ง]

เรียน ท่าน อาจารย์ และสมาชิกที่รู้ทุกท่าน ปัญหาในหัวข้อนี้ที่อยากขอความช่วยเหลือคือว่า
๑. ผมต้องกาน Format ตารางโดยใช้ VBA เป็นตัวช่วยครับคือ Format Painter ของตารางใหม่ให้เหมือนกับตารางต้นทุกอย่างครับ ช่วยแนะนำโคดที่ผม Record Macro นี้ให้ใช้ได้เมื่อตารางมาก หลื น้อยกว่านี้ครับ

Code: Select all

Sub Macro1()
    Range("A1:AG11").Select
    Selection.Copy
    Range("AI1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("BQ1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("CY1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1:AG1").Select
End Sub

โคดนี้ผมได้จากการ Record Macro ถ้ามี 100 ตารางจำต้อง

Code: Select all

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

100 เทื่อครับ และเมื่อตารางลดลงก่อต้องมาลบ

Code: Select all

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

นี้ลงอีก ประกดว่าหยุ้งยากมากครับ
ขอบคุณล่วงหน้า

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    Range("A1:AG11").Copy
    For i = 1 To j Step 34
        Sheets("Sheet1").Cells(1, i).PasteSpecial Paste:=xlPasteFormats
    Next i
    Application.CutCopyMode = False
End Sub

[วังวู ช่ง]

เรียน ท่าน อาจารย์ ครับ ใก้ได้แล้ว แต่ย้อนผมปรับโคดไม่เป็นครับ รบกวนท่านอีกทีครับ

ขอบคุณล่วงหน้าครับ

[snasui]

ไม่ทราบว่าปัญหาคืออะไรครับ Code ที่ตอบไปนั้นติดขัดตรงส่วนใด ต้องการคำตอบเป็นอย่างไร ช่วยอธิบายมาอีกครั้งครับ

[วังวู ช่ง]

เรียนท่านอาจารย์ครับ ไม่สาบว่าเป็นนำละบบ Office ของผม หลืไม่ครับ เพาะโคดที่ ท่าน อาจารย์ทำให้ผม Run แล้วไดเหมือน Sheet2 แต่ความต้องการคือ Sheet3 ครับ แต่ไม่จำกัดตาราง อาดจะมากหลืน้อยกว่าก่อได้ครับ

มีไฟล์แนบมาครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    Range("A1:AG11").Copy
    For i = 35 To j Step 34
            Sheets("Sheet1").Cells(1, i).PasteSpecial Paste:=xlPasteFormats
    Next i
    Application.CutCopyMode = False
End Sub

[วังวู ช่ง]

เรียนท่าน อาจารย์ที่เคารบครับ ได้คำตอบที่ถูกต้องที่สุดแล้วครับ ขอบคุณมากๆครับ

[วังวู ช่ง]

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

Code: Select all

Sub Macro2()
    Columns("AH:AH").Select
    Selection.Delete Shift:=xlToLeft
    Columns("BO:BO").Select
    Selection.Delete Shift:=xlToLeft
    Columns("CV:CV").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:AG1").Select
End Sub

ขอบคุณล่วงหน้านำความช่วยเหลือครับ

[snasui]

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

Code: Select all

Sub Macro()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    For i = j - 33 To 1 Step -34
        Sheets("Sheet1").Cells(1, i).EntireColumn.Delete
    Next i
End Sub

[วังวู ช่ง]

เรียนท่าน อาจารย์ครับ ได้แล้วครับ ได้คำตอบที่ถูกต้องตามความต้องกานจิงๆครับ
code ที่อาจารย์แนะนำสามารถ run ข้อมูลได้ตามต้องการ เป็น code ที่ดีมากเลียครับ ขอบคุณอาจารย์มาก แต่ไลยะผ่านมาผมสึกสาโคดของอาจารย์มากที่สุด แต่ก่อเข้าใจยาก เพราะสะนั้นอยากจะรบกวนอาจารย์ช่วยอธิบายความหมายของ code บางส่วนด้วยครับ เพื่อที่ผมจะได้นำไปประยุกต์ใช้ต่อไป
ขอบคุณมากๆครับ

Code: Select all

Sub Macro1()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    Range("A1:AG11").Copy
    For i = 1 To j Step 34
        Sheets("Sheet1").Cells(1, i).PasteSpecial Paste:=xlPasteFormats
    Next i
    Application.CutCopyMode = False
End Sub

Code: Select all

Sub Macro()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    For i = j - 33 To 1 Step -34
        Sheets("Sheet1").Cells(1, i).EntireColumn.Delete
    Next i
End Sub

[snasui]

ผมอธิบาย Code ไว้เป็น Comment ลองศึกษาดูครับ

Code: Select all

Sub Macro1()
    Dim i As Integer, j As Integer 'ประกาศตัวแปร i และ j เป็น Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count 'กำหนดค่าให้ตัวแปร j มีค่าเท่ากับคอลัมน์ที่มีการใช้งานทั้งหมด
    Range("A1:AG11").Copy ' Copy A1:AG11
    For i = 1 To j Step 34 'กำหนดให้ i มีค่าเท่ากับ 1- ค่าตัวแปร j และให้ Run ไปครั้งละ 34 แทนที่จะเป็นทีละ 1
        Sheets("Sheet1").Cells(1, i).PasteSpecial Paste:=xlPasteFormats 'นำค่าที่ Copy ไปวางที่บรรทัดที่ 1 และคอลัมน์ที่ได้จากค่าตัวแปร i
    Next i ' ไปยังเซลล์ถัดไป
    Application.CutCopyMode = False 'ยกเลิกคำสั่งการ Copy
End Sub

Code: Select all

Sub Macro()
    Dim i As Integer, j As Integer
    j = Sheets("Sheet1").UsedRange.Columns.Count
    For i = j - 33 To 1 Step -34 'กำหนดให้ i มีค่าเท่ากับ j-33 ถึง 1 แล้ว Run ลดลงครั้งละ 34
        Sheets("Sheet1").Cells(1, i).EntireColumn.Delete 'ลบทั้งคอลัมน์ตามค่าคอลัมน์ที่ได้จากตัวแปร i
    Next i ไปยังเซลล์ถัดไป
End Sub