Page 1 of 1
นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 11:23 am
by niwat2811
มีข้อมูลอยู่ในเซล A21 - I25 ต้องการให้ไปบันทึกที่ Sheet 2 ต่อกันไปเป็นคอลัมภ์ ไม่ทราบต้องแก้ไข Code อย่างไรครับ
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 11:44 am
by bank9597
ลองวางโค๊ดนี้ครับ
Code: Select all
Sub CopyValue()
On Error Resume Next
Dim r As Range, rAll As Range
Application.ScreenUpdating = False
With Sheets(1)
Set rAll = .Range(.Range("A21:I25"), .Range("I25").End(xlUp))
Set r = Sheets("Sheet2").Range("A11").End(xlToRight).Offset(, 1)
rAll.Copy
r.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Finish"
End Sub
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 12:31 pm
by niwat2811
ได้ลองนำ Code ของท่าน bank9597 ไปลองวางดูแล้วก็ยังไม่ได้ครับ ยังไงก็ขอขอบคุณท่าน bank9597 ที่ได้ช่วยแนะนำครับ
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 12:44 pm
by bank9597
ผมลองแล้วน่ะครับ ไม่มีปัญหาใดๆ ลองดูในไฟล์แนบแล้วหรือยังครับ
จากโจทย์บอกว่า
ข้อมูลอยู่ในเซล A21 - I25 ต้องการให้ไปบันทึกที่ Sheet 2 ต่อกันไปเป็นคอลัมภ์
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 12:49 pm
by niwat2811
กรณีที่ Sheet2 เราไม่มีข้อมูลบันทึกแล้วไม่ยอมไปครับ (คือว่าได้ลองลบข้อมูลที่ Sheet2 ออกทั้งหมด)
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 1:39 pm
by snasui
ลองปรับ Code เป็นตามด้านล่างครับ
Code: Select all
Sub CopyValue()
Dim r As Range, rAll As Range
Dim lng As Long
lng = Columns.Count
Application.ScreenUpdating = False
With Sheets(1)
Set rAll = .Range(.Range("A21"), .Range("I25"))
Set r = Sheets("Sheet2").Cells(11, lng).End(xlToLeft).Offset(, 1)
rAll.Copy
r.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Finish"
End Su
ลักษณะของการเก็บข้อมูลไปทางขวาแบบนี้เหมาะกับการทำรายงาน ปกติจะทำเพื่อการแสดงผลให้ง่ายต่อการดู หากทำเป็น Database จะไม่เก็บข้อมูลไปทางขวาครับ
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 1:47 pm
by niwat2811
เรียนท่านอาจารย์ครับ ผมได้ลองนำ Code ไปวางแล้ว และได้ทำการลบข้อมูลใน Sheet2 ทั้งหมด และได้กดปุ่ม To Sheet2 ปรากฎว่าข้อมูลที่บันทึกไปเริ่มต้นบันทึกที่ B11 แต่ว่าตามความต้องการ ต้องการให้เริ่มบันทึกที่ A11 ครับ รบกวนท่านอาจารย์ด้วยครับผม (ถูกต้องตามที่ท่านอาจารย์กล่าวครับคือต้องการที่จะนำไปทำรายงานครับซึ่งมีหลายร้อยหน้าครับ ขอบคุณท่านอาจารย์มากครับ)
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 1:50 pm
by bank9597
ลองเปลี่ยนที่ Offset จาก 1 เป็น 0 ครับ
Code: Select all
Sub CopyValue()
Dim r As Range, rAll As Range
Dim lng As Long
lng = Columns.Count
Application.ScreenUpdating = False
With Sheets(1)
Set rAll = .Range(.Range("A21"), .Range("I25"))
Set r = Sheets("Sheet2").Cells(11, lng).End(xlToLeft).Offset(, 0)
rAll.Copy
r.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Finish"
End Sub
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 2:11 pm
by snasui
ลองปรับ Code เป็นด้านล่างครับ
Code: Select all
Sub CopyValue()
Dim r As Range, rAll As Range
Dim lng As Long
lng = Columns.Count
Application.ScreenUpdating = False
With Sheets(1)
Set rAll = .Range(.Range("A21"), .Range("I25"))
Set r = Sheets("Sheet2").Cells(11, lng).End(xlToLeft).Offset(, _
IIf(Sheets("Sheet2").Range("A11") = "", 0, 1))
rAll.Copy
r.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Finish"
End Sub
Re: นำข้อมูลไปเรียงต่อกันในแนวคอลัมภ์ครับท่านอาจารย์
Posted: Wed Jan 18, 2012 2:23 pm
by niwat2811
รายงานผลครับ จากที่ได้ทดลอง Code ของคุณ bank9597 ผลคือไปวางทับคอลัมภ์สุดท้ายของข้อมูล ส่วน Code ของท่านอาจารย์ทดลองแล้วตรงกับความต้องการเลยครับ ขอบคุณทั้งสองท่านที่ได้สละเวลาช่วยเหลือ ขอบคุณมากครับสำหรับเวปที่แสนดีแห่งนี้