Page 1 of 1
ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่างครับ
Posted: Mon Mar 04, 2013 3:59 pm
by godman
สวัสดีครับ
ผมติดปัญหาว่า พอดีว่า ผมอยากจะวางข้อมูลจากหน้าenter แต่ว่าข้อมูลมีการวางข้ามชี้ตมากกว่า 1 ชี้ต เช่นชี้ต SOP ชี้ต WI และชี้ตอื่นๆที่อาจจะมีเพ่ิม
ครานี้หน้าฟอร์มก็มีชนิดของข้อมูลหลายประเภทถ้าประเภทตรงกับชื่อชี้ตใหนก็จะถูกไปวางในชี้ตนั้น แต่โค้ดที่ผมมีรู้สึกว่ามันจะไป active ทุกชี้ตแล้วทำให้เซลล์กลายเป็นเข้าใจว่าไม่ว่าง พอจะสลับมาวางมันก็จะกระโดดข้ามแถวนั้นไปแถวอื่นเพราะเข้าใจว่าแถวไม่ว่างครับ ผมไม่แน่ใจว่าจะเกี่ยวกับเซลล์ที่มีสูตรหรือไม่
ไม่ทราบว่าผมต้องเปลี่ยนแปลงโค้ดที่จุดใหนครับ ผมแนบไฟล์มาให้ โดยที่sheet Enter ช่อง 14 จะเป็นตัวควบคุมว่าข้อมูลจะไปยัง sheet ใดเป็นของชี้ตใด
Code: Select all
Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
= Application.Max(Worksheets("Master1") _
.Range("Ao:Ao")) + 1
With Worksheets("Template1")
i = Worksheets("Enter").Range("m6").Value
Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
End With
Set rt = Worksheets("Master1") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt1 = Worksheets("SOP") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt2 = Worksheets("WI") _
.Range("A65536").End(xlUp).Offset(1, 0)
rs.Copy
rt.PasteSpecial xlPasteValues
rs1.Copy
rt1.PasteSpecial xlPasteValues
rs2.Copy
rt2.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Finish"
End Sub
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Mon Mar 04, 2013 4:00 pm
by godman
ผมลืมบอกไปว่า ผมตั้งคุณสมบัติเป็น table เพื่อต้องการให้สูตรมันขยับเอง เมื่อแถวเพิ่มมาใหม่ครับ
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Mon Mar 04, 2013 4:45 pm
by tupthai
เพิ่มการตรวจสอบว่าเราเลือกให้ไปเพิ่มข้อมูลชีทไหน
Code: Select all
If [d14].Value = "SOP" Then
rs1.Copy
rt1.PasteSpecial xlPasteValues
Else
rs2.Copy
rt2.PasteSpecial xlPasteValues
End If
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Mon Mar 04, 2013 7:05 pm
by godman
ผมนำไปวางแล้ว ยังไม่ได้ครับ ยังคงกระโดดอยู่ครับ แต่ก็ขอบคุณคุณ tubthai มากครับ
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Mon Mar 04, 2013 7:13 pm
by joo

ต้องตัดโค๊ดบรรทัดนี้ออกไปก่อนครับ
Other..
rs.Copy
rt.PasteSpecial xlPasteValues
rs1.Copy
rt1.PasteSpecial xlPasteValues
rs2.Copy
rt2.PasteSpecial xlPasteValues
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Mon Mar 04, 2013 7:36 pm
by godman
ใช้ได้ดีเลยครับ สุดยอดมากครับ ทั้งสองท่าน ขอบคุณมาก
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 2:16 pm
by godman
สวัสดีครับ
ต้องขอบอกว่าที่ท่านผู้รู้ได้ตอบผมไป ผมได้นำไปต่อยอดแล้ว แต่ว่ามีความต้องการเพิ่มว่า ถ้าข้อมูลจากเซลล์ D6 ที่เป็นชื่อประเภทถ้าเป็นประเภทเดียวกันซึ่งได้จากการดูในช่อง B:B ของแต่ละชี้ต
ก็ให้วางแทนที่ ทั้งแถว เสมือนหนึ่งการวางแบบแก้ไขข้อมูลที่มีลักษณะบางอย่างเป็นตัวตั้งในที่นี้ผมใช้รหัสเอกสารหรืก Document Number เป็นตัวหลักในการแก้ไขข้อมูลแล้วเขียนโค้ดว่าถ้าคอลัมพ์ b:b มีชื่อตรงกันก็ให้นำข้อมูลใน template ไปวางแทนทั้งแถวครับ
แต่ผมได้ลองปรับโค้ดแล้วแต่ยัง error อยู่ครับ การ error จะเกี่ยวกับ else if ที่ผมยังไม่คล่องเขียน VB หรือปล่าวครับ ผมได้ส่งไฟล์มาตอนที่เขียนว่ายัง error อยู่ อยู่ชี้ตหลักคือ ชี้ต enter
Code: Select all
Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
= Application.Max(Worksheets("Master1") _
.Range("Ao:Ao")) + 1
With Worksheets("Template1")
i = Worksheets("Enter").Range("m6").Value
Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
End With
Set rt = Worksheets("Master1") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt1 = Worksheets("SOP") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt2 = Worksheets("WI") _
.Range("A65536").End(xlUp).Offset(1, 0)
Application.CutCopyMode = False
If [d14].Value = "SOP" Then
rs1.Copy
rt1.PasteSpecial xlPasteValues
Else
Dim lng As Long
lng = Application.Match(Sheets("BOM").Range("d6"), _
Sheets("SOP").Range("b:b"), 0)
Else
rs2.Copy
rt2.PasteSpecial xlPasteValues
Else
Dim lng As Long
lng = Application.Match(Sheets("BOM").Range("d6"), _
Sheets("WI").Range("b:b"), 0)
End If
MsgBox "Finish"
End Sub
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 2:21 pm
by godman
โทษครับผมลืมแก้โค้ดชื่อชี้ต ตอนนี้แก้ไขแล้วครับ แต่ยัง error อยู่
Code: Select all
Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
= Application.Max(Worksheets("Master1") _
.Range("Ao:Ao")) + 1
With Worksheets("Template1")
i = Worksheets("Enter").Range("m6").Value
Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
End With
Set rt = Worksheets("Master1") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt1 = Worksheets("SOP") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt2 = Worksheets("WI") _
.Range("A65536").End(xlUp).Offset(1, 0)
Application.CutCopyMode = False
If [d14].Value = "SOP" Then
rs1.Copy
rt1.PasteSpecial xlPasteValues
Else
Dim lng As Long
lng = Application.Match(Sheets("SOP").Range("d6"), _
Sheets("SOP").Range("b:b"), 0)
Else
rs2.Copy
rt2.PasteSpecial xlPasteValues
Else
Dim lng As Long
lng = Application.Match(Sheets("WI").Range("d6"), _
Sheets("WI").Range("b:b"), 0)
End If
MsgBox "Finish"
End Sub
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 2:27 pm
by tupthai
ผิดหลักไวยากรณ์ การใช้ if else elseif
ดูตาม link นี้ครับ
http://www.techonthenet.com/excel/formulas/if_then.php
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 3:21 pm
by godman
ผมได้เข้าไปอ่านแล้วครับ และได้แก้ไขโค้ดแล้ว แต่ว่ามันยังไม่วางทับอันที่เลขที่เอกสารตรงกันครับ คือมันก็วางต่อท้ายกันไปใช่ แต่ว่าผมอยากให้มันวางทับแถวเพื่อเอาอันที่ก้ไขแล้วแทนที่
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 3:22 pm
by godman
ผมได้เข้าไปอ่านแล้วครับ และได้แก้ไขโค้ดแล้ว แต่ว่ามันยังไม่วางทับอันที่เลขที่เอกสารตรงกันครับ คือมันก็วางต่อท้ายกันไปใช่ แต่ว่าผมอยากให้มันวางทับแถวเพื่อเอาอันที่ก้ไขแล้วแทนที่
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 4:10 pm
by tupthai
ลองดูครับว่าใช้ได้หรือเปล่า
Code: Select all
Sub RecordNew()
Dim rs As Range, rt As Range
Dim rs1 As Range, rt1 As Range
Dim i As Integer
Worksheets("Enter").Range("M8") _
= Application.Max(Worksheets("Master1") _
.Range("Ao:Ao")) + 1
With Worksheets("Template1")
i = Worksheets("Enter").Range("m6").Value
Set rs = .Range(.Range("A2"), .Range("AO" & i + 1))
Set rs1 = .Range("A6:O" & 6 + .Range("A4") - 1)
Set rs2 = .Range("A10:O" & 10 + .Range("A4") - 1)
End With
Set rt = Worksheets("Master1") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt1 = Worksheets("SOP") _
.Range("A65536").End(xlUp).Offset(1, 0)
Set rt2 = Worksheets("WI") _
.Range("A65536").End(xlUp).Offset(1, 0)
If [d14].Value = "SOP" Then
Set rt1 = Sheets("SOP").Cells(Application.Match(Sheets("SOP").Range("d6"), Sheets("SOP").Range("b:b"), 0), 1)
rs1.Copy
rt1.PasteSpecial xlPasteValues
Else
Set rt2 = Sheets("WI").Cells(Application.Match(Sheets("SOP").Range("d6"), Sheets("SOP").Range("b:b"), 0), 1)
rs2.Copy
rt2.PasteSpecial xlPasteValues
End If
Application.CutCopyMode = False
MsgBox "Finish"
End Sub
Re: ติดปัญหาการ paste data แล้วข้อมูลไม่วางต่อกันจากบนลงล่าง
Posted: Tue Mar 05, 2013 6:56 pm
by godman
ขอบคุณมากครับ ใช้งานได้ดีเลยแหละ สุดยอดมาก