Page 1 of 1
การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 9:10 am
by hutthaya
ไฟล์ตัวอย่างนะค่ะ
อยากให้มีการ insertrows ละ insert columns ออกมาตามรูปแบบ sheet: exam ค่ะ อยากให้ได้ออกมาตามฟอแมตนั้นเลยค่ะ
อยากได้เป็นโค้ด vba เพื่อจะไปประยุกต์ใช้ต่อค่ะ ผู้รู้ช่วยแนะนำด้วยน่ะค่ะ ขอบคุณค่ะ
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 9:12 am
by snasui

ต้องขออภัยที่จะบอกว่า ที่นี่ไม่แจก Code ครับ ต้องเขียนมาเองก่อน ติดแล้วค่อยถามกันได้เรื่อย ๆ ครับ
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 1:41 pm
by hutthaya
จะ insert คอลัมน์ยังไงให้แสดงชื่อเดือนเรียงต่อกันค่ะอาจาร์ยหนูมองไม่ออกเลยค่ะ
ลองรันโค้ดด้านล่างนี้นะค่ะ
Code: Select all
Function showmonthmps()
Dim i As Integer, x As Integer
Dim month() As String
Dim no_d As Single, sum As Single, total As Single
i = 1
no_d = 0
Do Until Worksheets("MONTH").Cells(i + 1, 1).Value = ""
i = i + 1
no_d = no_d + 1
Loop
ReDim month(1 To no_d)
i = 1
For i = 1 To no_d ' collection with array sheet : MPS COMPARE
month(i) = Worksheets("MONTH").Cells(1 + i, 1).Value
Next i
i = 1
For i = 1 To no_d
If Worksheets("MPS COMPARE").Cells(6, 2 + i).Value = "" Then
'MPS1
Worksheets("MPS COMPARE").Cells(6, 2 + i).NumberFormat = "@"
Worksheets("MPS COMPARE").Cells(6, 2 + i).Value = Worksheets("MONTH").Cells(1 + i, 1).Value
[color=#FF0000]Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'end frist month show commit
Call comparefmonth1mps1[/color]End If
Next i
End Function
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 1:51 pm
by snasui

ถ้ายังเขียน Sub Procedure เป็น Function Procedure อยู่เช่นเดิม ผมจะไม่ตอบ เนื่องจากแจ้งไปหลายรอบแล้วครับ
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 2:03 pm
by hutthaya
ขอโทษจริงๆค่ะอาจาร์ย แก้ไขแล้วค่ะ หนูลืมแก้ไขตลอดเลยต่อไปจะแก้ไขการเขียนค่ะ
Code: Select all
Public Sub showmonthmps()
Dim i As Integer, x As Integer
Dim month() As String
Dim no_d As Single, sum As Single, total As Single
i = 1
no_d = 0
Do Until Worksheets("MONTH").Cells(i + 1, 1).Value = ""
i = i + 1
no_d = no_d + 1
Loop
ReDim month(1 To no_d)
i = 1
For i = 1 To no_d ' collection with array sheet : MPS COMPARE
month(i) = Worksheets("MONTH").Cells(1 + i, 1).Value
Next i
i = 1
For i = 1 To no_d
If Worksheets("MPS COMPARE").Cells(6, 2 + i).Value = "" Then
'MPS1
Worksheets("MPS COMPARE").Cells(6, 2 + i).NumberFormat = "@"
Worksheets("MPS COMPARE").Cells(6, 2 + i).Value = Worksheets("MONTH").Cells(1 + i, 1).Value
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'end frist month show commit
Call comparefmonth1mps1
End If
Next i
End Sub
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Thu Jan 16, 2014 2:59 pm
by snasui

ตัวอย่าง Code สำหรับแทรกคอลัมน์ ลองปรับใช้ดูครับ
Code: Select all
Sub test()
Dim rAll As Range
Dim i As Integer
With Sheets("MPS COMPARE")
Set rAll = .Range("c6", .Cells(6, Columns.Count).End(xlToLeft))
End With
For i = rAll.Count To 2 Step -1
rAll(i).EntireColumn.Insert
Next i
End Sub
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Mon Jan 20, 2014 2:27 pm
by hutthaya
ขอบคุณน่ะค่ะอาจาร์ย
คือตอนนี้หนูะเอาโค้ดที่อาจาร์ยให้มาประยุกต์ใช้กับการ insert ชื่อพร้อมคอลัมน์แล้ว แต่หนูอยากให้ตารางสามารถ insert มาเหมือนตารางที่อยู่ในไฟล์ sheet : TEMPLATE ค่ะ
ตอนนี้แสดงมาได้แค่ mps เดียวอยู่เลยค่ะ
ลำดับการแสดงข้อมูล
Code: Select all
Public Sub compare11()
Call insertcolumns
Call compareprocap
Call comparefmonth1mps1
End Sub
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Mon Jan 20, 2014 2:47 pm
by snasui

ผมเห็นว่าสิ่งที่ควรทำคือด้านล่าง
- ใช้ PivotTable สำหรับทำงานนี้
- หากต้องการทำด้วย Code เพื่อแสดงความสามารถหรือเพื่อการใดก็ตาม
- นำข้อมูลมาวางให้ครบ ซึ่งจะทำ Subtotal ไปพร้อมกับวางข้อมูลหรือวางข้อมูลให้จบก่อนแล้วค่อยแทรก Subtotal เพื่อลดความซับซ้อน
- จัด Format ตามต้องการ โดยแยก Code สำหรับการจัด Format ออกมาต่างหาก เพื่อลดความซับซ้อน
สำหรับ Code ที่แจ้งมานั้นผมลอง Run แล้ว
ไม่เกิดผลลัพธ์การแทรกคอลัมน์ ควรทำให้เสร็จเป็นขั้น ๆ ไม่ว่าจะด้วยวิธีใดแล้วถามเฉพาะที่ติดปัญหา หากผมทดสอบไม่ถูกต้องช่วยลำดับการทดสอบมาให้ด้วยครับ
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Mon Jan 20, 2014 3:03 pm
by hutthaya
ไฟล์นี้เกิดการแทรกคอลัมน์ค่ะอาจาร์ย
Public Sub compare11()
Call insertcolumns ' จะทำการแทรกคอลัมน์ก่อน
Call compareprocap 'จะแสดงชื่อโปรดัคและคาปาซิตี้
Call comparefmonth1mps1 ' แสดงค่าซัมของเดือนแรก
End Sub
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Mon Jan 20, 2014 4:51 pm
by snasui

ไฟล์ที่แนบมามีการแทรกคอลัมน์และวางข้อมูลเรียบร้อยแล้ว ไม่ทราบว่าติดปัญหาใด
หากปัญหาคือไม่สามารถ Loop เพื่อที่จะให้ข้อมูลแสดงเหมือน Template ได้นั้น Code ที่จะทำเช่นนั้นจะต้องเขียนมาเองก่อนครับ ติดแล้วค่อยถามกันครับ
หากเขียนมาแล้ว Code นั้นชื่ออะไร ติดที่บรรทัดใด ยกมาเฉพาะที่ติดปัญหาจะได้เข้าถึงข้อมูลได้เร็วขึ้นครับ
Re: การ insertrow ละ nsert columns ออกมาทีละแถว
Posted: Tue Jan 21, 2014 11:15 am
by hutthaya
ขอบคุณค่ะอาจาร์ยเดี๋ยวหนูลองแก้ไขเพิ่มเติมก่อนนะค่ะ
