เรียนอาจารย์
ผมลองเขียนสูตรดูแล้วครับโดยศึกษาจากเวปของอาจารย์
ผมเข้าใจว่าใน 2 หัวข้อนี้น่าจะช่วยผมได้ พอลองทำไม่ได้จริงๆครับ
- cilp VBA Excel - Loop Structure - For...Next #L 38/40
- clip VBA Excel - Loop Structure - For...Loop 2 #L 39/40
รบกวนอาจารย์ให้คำแนะนำด้วยครับ
คือจากเดิมเราจะใช้ For i = 1 To rall.Count Step 9 คือเมื่อเจอคำๆใดจะ copy ข้อมูลไป 9 แถว
แต่ปัญหาคือถ้าคำนั้นไม่ถึง 9 แถวมันจะ Copy ของแถวอื่นมาด้วยครับ
ผมลองเขียนสูตรตามความเข้าใจมาให้ดูครับแต่ไม่ได้
รบกวนอาจารย์ช่วยแนะนำทีครับ
ขอบคุณมากครับ
#ไฟล์ ME15812_01 คือไฟล์ข้อมูลที่ต้องการ
#ไฟล์ ME15812_02 คือไฟล์ที่โปรแกรมเดิม copy มาครับ
โปรแกรมที่ผมลองเขียนใหม่ครับ
Code: Select all
Sub Test0()
Dim rall As Range, shStr As String
Dim rs As Range, rt As Range
Dim i As Integer, j As Integer
With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
For Each rs In rall
If rs.Value = "M.5A" Then
shStr = rall(i).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E98")
For j = 4 To 4
rt.Resize(rs).Value = _
rall(rs).Offset(0, j).Resize(rs).Value
Set rt = rt.Offset(0, 1)
Next j
End If
Next
End With
End Sub
โปรแกรมตัวเก่าที่ใช้อยู่ครับ
Code: Select all
Sub Test0()
Dim rall As Range, shStr As String
Dim rs As Range, rt As Range
Dim i As Integer, j As Integer
Dim k As Integer, l As Integer
Dim m As Integer, n As Integer
Dim o As Integer, p As Integer
Dim q As Integer, r As Integer
Dim v As Integer, w As Integer
With Workbooks("ME15812 MOLD LOWER.xlsx").Worksheets("ME15812 MOLD LOWER")
Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
For i = 1 To rall.Count Step 9
shStr = rall(i).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E98")
For j = 4 To 4
rt.Resize(9).Value = _
rall(i).Offset(0, j).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next j
Next i
For k = 1 To rall.Count Step 9
shStr = rall(k).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("H108")
For l = 5 To 7
rt.Resize(9).Value = _
rall(k).Offset(0, l).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next l
Next k
For m = 1 To rall.Count Step 9
shStr = rall(m).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E117")
For n = 10 To 15
rt.Resize(9).Value = _
rall(m).Offset(0, n).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next n
Next m
For o = 1 To rall.Count Step 9
shStr = rall(o).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E126")
For p = 17 To 22
rt.Resize(9).Value = _
rall(o).Offset(0, p).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next p
Next o
End With
With Workbooks("ME15812 MOLD UPPER.xlsx").Worksheets("ME15812 MOLD UPPER")
Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
For q = 1 To rall.Count Step 9
shStr = rall(q).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E108")
For r = 4 To 6
rt.Resize(9).Value = _
rall(q).Offset(0, r).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next r
Next q
For v = 1 To rall.Count Step 9
shStr = rall(v).Value
Set rt = Workbooks("ME 15812.xlsx").Worksheets(shStr).Range("E162")
For w = 7 To 9
rt.Resize(9).Value = _
rall(v).Offset(0, w).Resize(9).Value
Set rt = rt.Offset(0, 1)
Next w
Next v
End With
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
