EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub Macro01()
Dim i As Integer, j As Integer, t As String
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
t = t & .Cells(8, i).CurrentRegion.Resize(.Cells(8, i) _
.CurrentRegion.Rows.Count + 7).Offset(-7, 0).Address & ","
Next i
Application.Goto .Range(Mid(t, 1, Len(t) - 1))
End With
End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
.PageSetup.PrintArea = .Cells(8, i) _
.CurrentRegion.Resize(.Cells(8, i) _
.CurrentRegion.Rows.Count + 7) _
.Offset(-7, 0).Address
.PageSetup.PrintTitleRows = "$1:$9"
.PageSetup.FitToPagesWide = 1
.PrintOut
Next i
End With
End Sub
Code: Select all
Sub Macro01()
Dim i As Integer, j As Integer, t As String
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
t = t & .Cells(8, i).CurrentRegion.Resize(.Cells(8, i) _
.CurrentRegion.Rows.Count + 7).Offset(-7, 0).Address & ","
Next i
Application.Goto .Range(Mid(t, 1, Len(t) - 1))
End With
End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
.PageSetup.PrintArea = .Cells(8, i) _
.CurrentRegion.Resize(.Cells(8, i) _
.CurrentRegion.Rows.Count + 7) _
.Offset(-7, 0).Address
.PageSetup.PrintTitleRows = "$1:$9"
.PageSetup.FitToPagesWide = 1
.PrintOut
Next i
End With
End Sub
สามารถปรับเป็น Code ตามด้านล่างครับวังวู ช่ง wrote:เรียน ท่านอาจารย์ ที่เคารพครับ ถ้าแก้ไขโคดลุ่มนี้เป็นการเลือกตารางจำนวนมากๆจะแก้ไขตงไหน และแก้ไขอย่างไลครับ?
Code: Select all
Sub Macro01() Dim i As Integer, j As Integer, t As String With Sheets("List") j = .UsedRange.Columns.Count For i = 1 To j Step 34 t = t & .Cells(8, i).CurrentRegion.Resize(.Cells(8, i) _ .CurrentRegion.Rows.Count + 7).Offset(-7, 0).Address & "," Next i Application.Goto .Range(Mid(t, 1, Len(t) - 1)) End With End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer, r As Range
Set r = Sheets("List").Range("A1")
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
Set r = Union(r, Range(.Cells(8, i).CurrentRegion.Resize(.Cells(8, i) _
.CurrentRegion.Rows.Count + 7).Offset(-7, 0).Address))
Next i
r.Select
End With
End Sub
กรณีไม่ต้องการ Print สามารถที่จะลบ .PrintOut ออกไปก่อน หรือเติมเครื่องหมาย ' (Single Quote) นำหน้า .PrintOut เพื่อให้เป็น Comment จะได้เป็น '.PrintOutวังวู ช่ง wrote:เรียน ท่านอาจารย์ ที่เคารพครับ ส่วนโคดข้างลุ่มนี้ผมไม่รู้จะใช้ครับ เพาะเมื่อ Run Macro แล้วเคื่องปรีนเตีจะทำงานทันทีโดยเอาข้อมูลออกมาครับ
Code: Select all
Sub SubSelectTable() Dim i As Integer, j As Integer With Sheets("List") j = .UsedRange.Columns.Count For i = 1 To j Step 34 .PageSetup.PrintArea = .Cells(8, i) _ .CurrentRegion.Resize(.Cells(8, i) _ .CurrentRegion.Rows.Count + 7) _ .Offset(-7, 0).Address .PageSetup.PrintTitleRows = "$1:$9" .PageSetup.FitToPagesWide = 1 .PrintOut Next i End With End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer, r As Range
Set r = Sheets("List").Range("A1")
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
Set r = Union(r, .Range(Cells(1, i).CurrentRegion.Address))
Next i
r.Select
End With
End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer, r As Range
Set r = Sheets("List").Range("A1")
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
Set r = Union(r, .Range(Cells(1, i).CurrentRegion.Address))
Next i
r.Select
End With
End Sub
Code: Select all
Sub SubSelectTable()
Dim i As Integer, j As Integer, r As Range
Set r = Sheets("List").Range("A1")
With Sheets("List")
j = .UsedRange.Columns.Count
For i = 1 To j Step 34
Set r = Union(r, Range(.Cells(1, i).CurrentRegion.Resize(.Cells(1, i) _
.CurrentRegion.Rows.Count + 10).Address))
Next i
r.Select
End With
End Sub
คุณ วังวู ช่ง เป็นสมาชิกจากประเทศเพื่อนบ้านเรา จึงไม่ถนัดภาษาไทยครับsongsug wrote:อาจารย์ต้องเปิดห้องสอนภาษาไทยแล้วล่ะผมว่า