ตรวจสอบและปรับปรุงไฟล์ 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] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub Paste()
Dim irRange As Range
Worksheets("sheet1").Range("c3:c7").Copy
Worksheets("sheet2").Select
Set Item = Worksheets("sheet2").Range("B3:B1000").Cells.Find(What:=Range("b2").Value)
If Item Is Nothing Then
Worksheets("sheet2").Cells(65536, "B").End(xlUp).Offset(1, 0).Select
Else
Item.Activate
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
With Worksheets("sheet2")
Set irRange = .Range("b3", .Range("f" & Rows.Count).End(xlUp))
irRange.Borders.LineStyle = xlContinuous
irRange.Sort Key1:=.Range("b3"), Order1:=xlAscending, Header:=xlGuess
End With
With Worksheets("sheet1")
.Range("c3:c7").ClearContents
.Range("C4:C7").Formula = "= vlookup($C$3,range(names)" & Range("b1000").End(xlUp).Row & ",match(c3,names,0),0)"
Range("B4:c4").Copy
Range("B4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Worksheets("sheet1").Select
Range("C4").Select
End Sub
ที่เข้าใจถูกต้องแล้ว แต่ที่คิดนั่นก็ถูกต้องอีก คือ CODE ต้องการให้นำFUNCTION VLOOKUP ไปวางที่bank9597 wrote:
1. ต้องการบันทึกข้อมูลไปเก็บ
2. ต้องการอัพเดทข้อมูล
3. ต้องการดึงข้อมูลมาแสดง
ซึ่งผมทดสอบโค๊ดดูแล้ว ก็ยังไม่เข้าใจ ยังคงเห็นว่าเป็นการบันทึกข้อมูลเท่านั้น
ที่คิดไปเองคือ สงสัยว่าจะให้มีการคีย์รหัสในเซลล์ C3 ชีท1 แล้วให้ข้อมูลในชีท2 ที่มีรหัสตรงกันนำข้อมูลมาแสดง
ลองปรับโค๊ดตามนี้ดูครับว่าได้หรือไม่
Code: Select all
Sub Paste()
Dim irRange As Range
Worksheets("sheet1").Range("c3:c7").Copy
Worksheets("sheet2").Select
Set Item = Worksheets("sheet2").Range("B3:B1000").Cells.Find(What:=Range("b2").Value)
If Item Is Nothing Then
Worksheets("sheet2").Cells(65536, "B").End(xlUp).Offset(1, 0).Select
Else
Item.Activate
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
With Worksheets("sheet2")
Set irRange = .Range("b3", .Range("f" & Rows.Count).End(xlUp))
irRange.Borders.LineStyle = xlContinuous
irRange.Sort Key1:=.Range("b3"), Order1:=xlAscending, Header:=xlGuess
End With
With Worksheets("sheet1")
.Range("c3:c7").ClearContents
.Range("c3:c7").ClearContents
.Range("C4").Formula = "= VLOOKUP(C3,sheet2!B3:F100,2,0)"
.Range("C5").Formula = "= VLOOKUP(C3,sheet2!B3:F100,3,0)"
.Range("C6").Formula = "= VLOOKUP(C3,sheet2!B3:F100,4,0)"
.Range("C7").Formula = "= VLOOKUP(C3,sheet2!B3:F100,5,0)"
End With
Worksheets("sheet1").Select
Range("C4").Select
End Sub
ที่ว่านำไปวางต่อท้ายคืออะไรครับ ใช่การวางต่อจากรหัสที่เหมือนกันหรือเปล่าการวางข้อมูล แบ่งเป็น 2 กรณี ดังนี้bank9597 wrote:
เช่น รหัส 2 มีการแก้ไข พอนำไปบันทึก มันก็จะบันทึกต่อจากรหัส 2 ใช่หรือไม่
ผมทดสอบไฟล์ที่ตอบไปแล้ว รู้สึกจะตรงกับที่คุณต้องการแล้ว
pongpang wrote:เรียน อาจารย์ทุกท่าน
ความต้องการ
1.คีย์ข้อมูลแล้วคัดลอกข้อมูลจากชีทที่1 ไปวางในชีทที่2
2.การนำข้อมูลไปวางในชีทที่ 2 วาง ตามลำดับเลขที่(ไม่จำเป็นต้องบันทึกเรียงลำดับ)
3.ในกรณีแก้ไขข้อมูล ให้นำข้อมูลที่แก้ไขวางทับข้อมูลเดิม
1. วางข้อมูลได้ตามต้องการ
2. เมื่อแก้ไขข้อมูล ข้อมูลจะเพิ่มอีก 1 row ไม่ทับข้อมูลเดิม
3. การวางสูตร ERROR ตามภาพ
เมื่อไหร่จะเป็นวางต่อแถว เมื่อไหร่จะเป็นการวางทับ มีเงื่อนไขอะไรกำหนดไว้บ้างครับขอบคุณที่ให้การช่วยเหลือbank9597 wrote:
ถ้าไม่กำหนดเงื่อนไขชัดเจน ก็ไม่สามารถเขียนโค๊ดได้ครับ เช่นเดียวกัน เราไม่สามารถทำสองอย่างในเวลาเดียวกันได้ เว้นแต่จะมีเงื่อนไขจำกัดไว้
pongpang wrote:ขอบคุณที่ให้การช่วยเหลือbank9597 wrote:
ถ้าไม่กำหนดเงื่อนไขชัดเจน ก็ไม่สามารถเขียนโค๊ดได้ครับ เช่นเดียวกัน เราไม่สามารถทำสองอย่างในเวลาเดียวกันได้ เว้นแต่จะมีเงื่อนไขจำกัดไว้
มีเงื่อนไข ดังนี้
1.ข้อมูลเก่า(เลขที่ ที่เคยบันทึกไว้แล้ว นำข้อมูลแก้ไข)วางทับที่เดิม
2.ข้อมูลใหม่ คือการบันทึกเลขที่ ที่ยังไม่เคยบันทึกมาก่อน ให้นำไปต่อด้านล่าง
งงไปใหญ่เลยครับ ตกลงว่ามีแค่ 2 กรณีเท่านั้น คือบันทึกเข้า กับ ปรับปรุงข้อมูล (ตามที่เข้าใจในขณะนี้)Code: Select all
Sub Paste()
Dim wsPaste As Worksheet
Dim temp As Worksheet
Set wsPaste = Sheets("Sheet2")
Set temp = Sheets("Sheet1")
If temp.Range("E3") = 0 Then
temp.Range("F3:J3").Copy
wsPaste.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "บันทึกข้อมูลเรียบร้อย", vbInformation
ElseIf IsNull(temp.Range("C3")) Then
MsgBox "๕ุณยังไม่กรอกรหัส", vbInformation
Else
With Application
Dim i As Integer
i = .Match(temp.Range("C3"), wsPaste.Range("B3:B100")) + 1
temp.Range("G3:J3").Copy
wsPaste.Cells(i, 3).Offset(1, 0).PasteSpecial xlPasteValues
MsgBox "แก้ไขข้อมูลเรียบร้อยแล้ว", vbInformation
Application.CutCopyMode = False
End With
End If
End Sub