ตรวจสอบและปรับปรุงไฟล์ Excel ให้เร็วและเสถียรด้วย File Anatomy Add-in
เครื่องมือนี้ช่วยวิเคราะห์โครงสร้างไฟล์อย่างละเอียด เช่น สูตร, ลิงก์, PivotTable, Styles และ Objects
พร้อมฟังก์ชันล้างสิ่งเกินจำเป็นที่ทำให้ไฟล์ช้า หรือเสียหายได้ในคลิกเดียว
เหมาะสำหรับผู้ใช้ Excel ที่ต้องการควบคุมคุณภาพไฟล์อย่างมืออาชีพ
ทดลองใช้ Add-in
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
ระบุ Version ของ Excel 
โปรดทราบ สมัครสมาชิก
Login ผ่าน Facebook Reset รหัสผ่าน ติดต่อผู้ดูแลระบบ ตั้งค่าส่วนตัว วิธีการตั้งและตอบกระทู้ จัดรูปแบบตัวอักษร กำหนดขนาดตัวอักษรใน Browser
คำแสดงเจตนา[code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
เอาไปวางด้วยเงื่อนไขใดครับ ถ้าไม่มีเงื่อนไขก็แค่ Link ไปเฉย ๆ คือ คลุมข้อมูลที่ต้องการ > Copy > คลิกขวาบนเซลล์เป้าหมาย > Paste Special > Paste Link ไม่ต้องเขียนสูตรอื่นใดครับเงื่อนไข คือให้กรองเฉพาะข้อมูล ตาม column ที่เราต้องการเท่านั้นมาแสดงครับ คือ 4 column และให้ข้อมูลsnasui wrote:
คำตอบเดิมครับ เมื่อต้องการเฉพาะคอลัมน์ก็ Copy ไปวางแบบ Link เฉพาะคอลัมน์ ยกเว้นจะเลือกบางค่าในคอลัมน์ นั้น ๆ ถึงจะต้องเขียนสูตรที่ซับซ้อนขึ้นไปครับ การ Copy แบบ Link เราทำแค่ครั้งแรกที่สร้างงานนี้เท่านั้นครับ สามารถ Link ได้ทั้งคอลัมน์ ค่าที่เปลี่ยนแปลงจากต้นทางก็จะเปลี่ยนไปที่ปลายทางเสมอครับขอท้าวความก่อนครับ คือ shee1 จะไป file ที่ลูกค้าส่งมาให้เรา ส่วน sheet 2 เราต้องการมาจัด Formatsnasui wrote:
ยังไม่กระจ่างในสิ่งที่ต้องการจะทำครับและหากเงื่อนไขมีว่าได้รับข้อมูลมาเฉพาะชีท 1 ชีทเดียว ต้องการให้สร้างชีท 2 และวางข้อมูลอัตโนมัติ อย่างนี้ถึงจะต้องพึ่ง VBA ครับsnasui wrote:
ถ้าหากต้องการให้นำข้อมูลไปแสดงที่ชีท 2 เฉพาะคอลัมน์โดยไม่มีเงื่อนไข สามารถที่จะ Copy แล้ววางแบบ Link ได้เลย และหากต้องมีการจัด Format จะต้องทราบด้วยครับว่าัจัด Format เป็นแบบใด ถ้าแค่วางสับคอลัมน์กันเท่านั้นก็สามารถทำในตอน Copy และวางแบบ Link คือต้องค่อย ๆ Copy มาทีละคอลัมน์จนครบ
หากเงื่อนไขมีว่าดึงมาเฉพาะทุกบรรทัดที่มีค่า x อันนี้ต้องพึ่งสูตรที่ซับซ้อนขึ้น และหากเงื่อนไขมีว่าได้รับข้อมูลมาเฉพาะชีท 1 ชีทเดียว ต้องการให้สร้างชีท 2 และวางข้อมูลอัตโนมัติ อย่างนี้ถึงจะต้องพึ่ง VBA ครับ
ลองดู Code ด้านล่างครับCode: Select all
Sub CopyRage()
On Error Resume Next
Worksheets.Add
ActiveSheet.Name = "2"
Worksheets("1").Range("V6:V73").Copy
Worksheets("2").Range("A1").PasteSpecial xlPasteValues
Worksheets("1").Range("O6:O73").Copy
Worksheets("2").Range("B1").PasteSpecial xlPasteValues
Worksheets("1").Range("L6:M73").Copy
Worksheets("2").Range("C1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
สามารถทำตามนี้ครับCode: Select all
Sub CopyRage()
Dim r1 As Range
Dim r2 As Range
Dim i As Integer
On Error Resume Next
Worksheets.Add
ActiveSheet.Name = "2"
Worksheets("1").Range("V6:V73").Copy
Worksheets("2").Range("A1").PasteSpecial xlPasteValues
Worksheets("1").Range("O6:O73").Copy
Worksheets("2").Range("B1").PasteSpecial xlPasteValues
Worksheets("1").Range("L6:M73").Copy
Worksheets("2").Range("C1").PasteSpecial xlPasteValues
With Worksheets("2")
i = .Range("B65536").End(xlUp).Row
Set r2 = .Range("A2:A" & i)
End With
For Each r1 In r2
If r1 = "" Then
r1 = r1.End(xlUp)
End If
Next
Application.CutCopyMode = False
End Subsnasui wrote:
1. ที่โปรแกรม Excel กดแป้น Alt+F11 จะเข้าหน้าต่าง VBE
2. ที่หน้าต่าง VBE คลิกเมนู Insert เลือก Module
3. Copy Code ด้านล่างนี้ไปวาง (ผมปรับเพิ่มให้หลังจากสังเกตเห็นว่าให้เติมข้อมูลให้เต็มช่องที่ว่าง ๆ ไว้ด้วย)4. กดแป้น Alt+Q เพื่อกลับไปยัง Excel และปิด VBECode: Select all
Sub CopyRage() Dim r1 As Range Dim r2 As Range Dim i As Integer On Error Resume Next Worksheets.Add ActiveSheet.Name = "2" Worksheets("1").Range("V6:V73").Copy Worksheets("2").Range("A1").PasteSpecial xlPasteValues Worksheets("1").Range("O6:O73").Copy Worksheets("2").Range("B1").PasteSpecial xlPasteValues Worksheets("1").Range("L6:M73").Copy Worksheets("2").Range("C1").PasteSpecial xlPasteValues With Worksheets("2") i = .Range("B65536").End(xlUp).Row Set r2 = .Range("A2:A" & i) End With For Each r1 In r2 If r1 = "" Then r1 = r1.End(xlUp) End If Next Application.CutCopyMode = False End Sub
5. เมื่อต้องการ Run Code ให้กดแป้น Alt+F8 > เลือก CopyRange > Run
เราสามารถสร้าง Object ใด ๆ เอาไว้เพื่อให้คลิกแล้ว Run Macro ได้ง่าย ๆ ครับ เมื่อสร้าง Object แล้วให้คลิกขวาที่ Object จากนั้นเลือก Assigned Macro > เลือก CopyRange
เปลี่ยนเลข 73 เป็นเลขใด ๆ ตามต้องการครับ (เช่นเปลี่ยนเป็น 65536) ส่วนจะให้คูณ 1000 ด้วยนั้นลองดู Code ตามด้านล่างครับ
Code: Select all
Sub CopyRage()
Dim r1 As Range
Dim r2 As Range
Dim i As Integer
On Error Resume Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "2"
Worksheets("1").Range("V6:V73").Copy
Worksheets("2").Range("A1").PasteSpecial xlPasteValues
Worksheets("1").Range("O6:O73").Copy
Worksheets("2").Range("B1").PasteSpecial xlPasteValues
Worksheets("1").Range("L6:M73").Copy
Worksheets("2").Range("C1").PasteSpecial xlPasteValues
With Worksheets("2")
i = .Range("B65536").End(xlUp).Row
Set r2 = .Range("A2:A" & i)
End With
For Each r1 In r2
If r1 = "" Then
r1 = r1.End(xlUp)
End If
r1.Offset(0, 1) = r1.Offset(0, 1) * 1000
Next
Application.CutCopyMode = False
End Sub