ขอสูตร VBA copy ข้อมูลจากไฟล์หนึ่งไปอีกไฟล์ แบบมีเงื่อนไข

[nakhonchai]

เรียนอาจารย์
ผมได้ลองแก้ไขตัวเลขบางส่วนในสูตร ปรากฏว่าได้ตามต้องการครับ
แต่ขออาจารย์ช่วยอธิบายส่วนนี้ให้หน่อยครับ ผมไม่เข้าใจส่วนนี้
ผมลองแบบมี " ' " และ ไม่มี สูตรก็สามารถทำงานได้ปกติ
#ขอบคุณอาจารย์มากครับ

แบบไม่มี

Code: Select all

          shStr = Replace(rall(i).Value, "M", " M")
          shStr = Replace(shStr, "-", "")
          

แบบมี

Code: Select all

'         shStr = Replace(rall(i).Value, "M", " M")
'         shStr = Replace(shStr, "-", "")

สูตรที่แก้ไขใหม่ครับ
ส่วน " For i = 1 To rall.Count Step 8 " แก้เป็น " For i = 1 To rall.Count Step 9 "
ส่วน " rt.Resize(3).Value = _ " แก้เป็น "rt.Resize(9).Value = _ "
ส่วน " rall(i).Offset(0, j).Resize(3).Value " แก้เป็น " rall(i).Offset(0, j).Resize(9).Value "

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 LOWER.xlsx").Worksheets("LOWER")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For i = 1 To rall.Count Step 9
'         shStr = Replace(rall(i).Value, "M", " M")
'         shStr = Replace(shStr, "-", "")
        shStr = rall(i).Value
        Set rt = Workbooks("Book.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
  
 End With
 End Sub

[logic]

เครื่องหมาย ' ที่อาจารย์ใช้ในโค้ดคือตัวที่ทำให้โค้ดใช้การไม่ได้ เครื่องหมายนี้เอามานำหน้าคำอธิบายโค้ดกันครับ

[nakhonchai]

สวัสดีครับ อาจารย์
ผมมีเรื่องสอบถามครับ พอดีวันนี้ลูกน้องเพิ่งแจ้งมาว่า VBA ที่ทำไปปัญหาส่วนนึงครับ
พอผมมานั่งดู ปรากฏว่า ปัญหาคือ
- ตรงสูตรที่ว่า " For i = 1 To rall.Count Step 9 "
ถ้าส่วนนั้นมีไม่ถึง 9 อาจมีแค่ 4 หรือ 5 มันจะ copy เอาเลขอื่นมาใส่ด้วยครับ
ทำให้ค่าที่ copy มาไม่ถูกต้อง
ตัวอย่าง
ที่ไฟล์ ME 15812 ที่ Sheet สีแดง M.5A, M.6-10A, M.6-10B, M.7A และ M.8A
จะ Copy ข้อมูลไม่ถูกค่า คือดึงข้อมูลในส่วนที่จะไปใส่ Sheet สีส้มมาใส่ด้วยครับ

ผมได้แนบไฟล์มาให้แล้วครับ
รบกวนอาจารย์ช่วยชี้แนะให้ด้วยครับ
#ขอบคุณมากครับ

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]

ได้ลองปรับแก้มาเองแล้วหรือไม่ แก้เป็นอย่างไร แก้แล้วติดปัญหาตรงไหน อย่างไร ถ้ายังไม่ลองปรับมาเอง ให้ลองปรับมาก่อนครับ

[nakhonchai]

เรียนอาจารย์
ผมลองเขียนสูตรดูแล้วครับโดยศึกษาจากเวปของอาจารย์
ผมเข้าใจว่าใน 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

[nakhonchai]

ตัวอย่างไฟล์ข้อมูลที่ต้องการครับ

[snasui]

ช่วยแนบไฟล์โปรแกรมพร้อม Code ล่าสุดมาด้วยจะได้สะดวกในการตอบครับ

[nakhonchai]

ขอบคุณอาจารย์มากครับ
มี 2 ไฟล์
- ไฟล์ที่ผมลองแก้ไขใหม่แต่ไม่ได้ผล
- ไฟล์เดิมที่ใช้อยู่ครับ แต่กรณีถ้าช่วงไหนมีไม่ถึง 9 ข้อมูลที่ได้จะไม่ถูกต้อง
อาจารย์พอแนะนำ เวป หรือ หนังสือให้หน่อยได้ใหมครับ
ผมอยากศึกษาให้เข้าใจมากกว่านี้
ตอนนี้ผมหาศึกษาทาง google และ Youtube ในส่วนที่อยากรู้ว่าเขียนแบบไหนเอาครับ
และไล่ค้นหาในกระทู้นี่ละครับ แบบแอบทักลักไปปรับใช้เอา 555

ขอบคุณอาจารย์อีกครั้งครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Dim rall As Range
Dim rs As Range, rt As Range, r As Range
Dim i As Integer, j As Integer
Dim o As Object, k As Integer
Dim a As Variant, b As Variant
Set o = CreateObject("Scripting.Dictionary")

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 Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME 15812_01.xlsx").Worksheets(a(i)).Range("E98")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 7
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
End With

ปรับ For j = ... ให้ตรงกับข้อมูลที่จะใช้จริง

Code นี้ยากมากจะต้องเข้าใจหลายเรื่อง คือการ Loop ด้วย For, Scripting.Dictionary, Array ลองค้นดูวิธีใช้แบบนี้ผ่าน Google และ Youtube ครับ

[nakhonchai]

ขอบคุณมากครับอาจารย์
ผมลองเขียนขยายไป copy แถวอื่น ตรงที่ต้องการเลยครับ

"Code นี้ยากมากจะต้องเข้าใจหลายเรื่อง คือการ Loop ด้วย For, Scripting.Dictionary, Array ลองค้นดูวิธีใช้แบบนี้ผ่าน Google และ Youtube ครับ"

#จะหาศึกษาเพิ่มเติมตามคำแนะนำครับ
#ขอบคุณมากๆครับอาจารย์

[nakhonchai]

สวัสดีครับอาจารย์
ผมใคร่ขอความช่วยเหลือดังนี้ครับ

นี่เป็นสูตรที่ผมเขียนครับ
มีปัญหาที่ว่า ถ้า sheet ไหนไม่ได้มีการ copy ข้อมูลมา มันจะใส่คำว่า "OK" ด้วย

ผมต้องการให้ใส่คำว่า "OK" ในช่องสีเหลืองใน ไฟล์ ME15812 เฉพาะกรณีที่ sheet นั้นมีการ copy ข้อมูลมาเท่านั้นครับ

ตัวอย่างในไฟล์ ME15812 SLIT จะไม่มีข้อมูลของ Sheet Sl-42 และ SL-46 เมื่อทำการ copy ข้อมูลจะต้องไม่ใส่คำว่า "OK" ในช่องเหลือง

รบกวนอาจารย์ช่วยให้คำชี้แนะด้วยครับ
ขอบคุณมากครับ

Code: Select all

Sub Button1_Click()

Dim rall As Range
Dim rs As Range, rt As Range, r As Range
Dim i As Integer, j As Integer
Dim e As Integer, f As Integer
Dim g As Integer, h As Integer
Dim m As Integer, n As Integer
Dim q As Integer, c As Integer
Dim v As Integer, w As Integer
Dim o As Object, k As Integer
Dim a As Variant, b As Variant
Set o = CreateObject("Scripting.Dictionary")

With Workbooks("ME15812 SLIT.xlsx").Worksheets("ME15812 SLIT")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F101")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 9
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j
    Next i
    
    For e = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(e)).Range("F104")
        b = Split(o.Item(a(e)), "|")
        For f = 12 To 17
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, f).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next f
    Next e
      
    For g = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(g)).Range("F98")
        b = Split(o.Item(a(g)), "|")
        For h = 24 To 29
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, h).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next h
    Next g
    
    For m = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(m)).Range("F119")
        b = Split(o.Item(a(m)), "|")
        For n = 38 To 40
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, n).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next n
    Next m

    For q = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(q)).Range("F116")
        b = Split(o.Item(a(q)), "|")
        For c = 41 To 46
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, c).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next c
    Next q

    For v = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(v)).Range("F113")
        b = Split(o.Item(a(v)), "|")
        For w = 47 To 52
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, w).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next w
    Next v

End With

Set wbTaget = Workbooks("ME15812.xlsx")
        
    Set shTaget = wbTaget.Sheets("SL-41")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-42")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-46")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-48")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-50")
        shTaget.Range("F122:U124").Value = "OK"
    Set shTaget = wbTaget.Sheets("SL-37")
        shTaget.Range("F122:U124").Value = "OK"

End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

With Workbooks("ME15812 SLIT.xlsx").Worksheets("ME15812 SLIT")
    Set rall = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
    For Each rs In rall
        If Not o.Exists(rs.Value) Then
            k = Application.CountIf(rall, rs.Value)
            o.Add Item:=rs.Address(0, 0) & "|" & k, Key:=rs.Value
        End If
    Next rs
    a = o.keys
    
    For i = 0 To UBound(a)
        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F101")
        b = Split(o.Item(a(i)), "|")
        For j = 4 To 9
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, j).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next j

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F104")
        b = Split(o.Item(a(e)), "|")
        For f = 12 To 17
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, f).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next f

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F98")
        b = Split(o.Item(a(g)), "|")
        For h = 24 To 29
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, h).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next h

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F119")
        b = Split(o.Item(a(m)), "|")
        For n = 38 To 40
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, n).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next n

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F116")
        b = Split(o.Item(a(q)), "|")
        For c = 41 To 46
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, c).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next c

        Set rt = Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F113")
        b = Split(o.Item(a(v)), "|")
        For w = 47 To 52
            rt.Resize(b(1)).Value = _
                .Range(b(0)).Offset(0, w).Resize(b(1)).Value
            Set rt = rt.Offset(0, 1)
        Next w
        Workbooks("ME15812.xlsx").Worksheets(a(i)).Range("F122:U124").Value = "OK"
    Next i
End With