Snasui Excel Forum

Posted: **Wed Dec 14, 2022 4:13 pm**

ตามโค๊ดด้านล่าง Copy เซล K ถึง N ถ้าผมอยาก Copy เซล T ถึง Y ด้วย ต้องเขียนโค๊ดแบบไหนให้ Copy พร้อมกันใน Code บันทัดเดียวครับ พอดีว่ามือใหม่ด้วย พยายามหาข้อมูลแล้วแต่ไม่ได้เลยครับ

dbbook.Sheets("BOM List").Range("K" & i & ":N" & i).Copy

Posted: **Wed Dec 14, 2022 4:18 pm**

มือใหม่ไม่จำเป็นต้อง Copy บรรทัดเดียว การ Copy บรรทัดเดียวควรจะเป็นข้อมูลที่ติดกัน เช่น จาก K:Z ไม่ใช่เว้นช่วงดังที่ถามมาครับ

ในการโพสต์ Code กรุณาทำตามข้อ 4 และ 5 ด้านบนครับ

Posted: **Thu Dec 15, 2022 2:56 pm**

ขนาดไฟล์ 2 MB กว่าครับอาจารย์ เอาแค่โค๊ดประมาณนี้ได้มั้ยครับ

For i = 4 To 60000
If dbbook.Sheets("BOM List").Range("B" & i).Value = mybook.Sheets("MainBOM").Range("N2").Value Then
dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
mybook.Sheets("MainBOM").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
mybook.Sheets("MainBOM").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
mybook.Sheets("MainBOM").Range("J" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AB" & i).Copy
mybook.Sheets("MainBOM").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
mybook.Sheets("MainBOM").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
dbbook.Sheets("BOM List").Range("AO" & i).Copy
mybook.Sheets("MainBOM").Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

End If

Posted: **Thu Dec 15, 2022 3:41 pm**

กรุณาตัดมาเฉพาะส่วนที่เป็นปัญหา ทำตัวอย่างขึ้นมาใหม่สำหรับการถามตอบโดยเฉพาะครับ

การโพสต์ Code ให้วางแบบ Code อ่านกฎการใช้บอร์ดข้อ 5 ด้านบนประกอบครับ

Posted: **Thu Dec 15, 2022 4:13 pm**

แบบนี้ใช้มั้ยครับอาจารย์ ตามโค๊ดสามารถ Run ได้ครับ แต่ไม่รู้ถูกหลักการหรือเปล่า คำถามมี 2 ข้อครับ
1. มีวิธีเขียนให้กระชับกว่านี้หรือป่าวครับ โดยเฉพาะช่วง Copy แล้ว Paste
2. ติดปัญหาตอน Paste เซลที่ไม่มีข้อมูล อยากให้ข้าม เซลนั้นไปเลย ไม่ต้องอ่านซ้ำ มีแนวทางแบบไหนบ้างครับ

Code: Select all

Sub MainBOM()
MsgBox "INPUT DATA NOW!!"

Dim mybook As Workbook
Dim i As Long
Dim dbbook As Workbook


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set mybook = ThisWorkbook

If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
    Set dbbook = Workbooks.Open("\\Lbox\meeting\EDS\New EDS\Confirm Spec\SX3000 ec\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
    
    mybook.Sheets("MainBOM").Range("A11:U500").ClearContents

        For i = 4 To 60000
            If dbbook.Sheets("BOM List").Range("B" & i).Value = mybook.Sheets("MainBOM").Range("N2").Value Then
            dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
            mybook.Sheets("MainBOM").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
            mybook.Sheets("MainBOM").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
            mybook.Sheets("MainBOM").Range("J" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AB" & i).Copy
            mybook.Sheets("MainBOM").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
            mybook.Sheets("MainBOM").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AO" & i).Copy
            mybook.Sheets("MainBOM").Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            
            End If
        Next i
        dbbook.Close
   
    End If
    
Set dbbook = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual


End Sub

Posted: **Thu Dec 15, 2022 4:26 pm**

ดูตัวอย่างการโพสต์ Code ที่นี่ครับ http://snasui.com/viewtopic.php?f=6&t=1187

สำหรับสิ่งที่ถามมานั้นสามารถทำได้ทุกอย่างที่ต้องการ กรุณาแนบไฟล์ตัวอย่างพร้อม Code มาด้วย อย่าลืมตัดมาเป็นตัวอย่างถามกันเฉพาะที่เป็นปัญหาดังที่กล่าวแล้วครับ

Posted: **Thu Dec 15, 2022 5:11 pm**

แก้ไข โพสต์ แล้วครับอาจารย์ ตามด้านบนครับ

Posted: **Thu Dec 15, 2022 6:52 pm**

snasui wrote: Thu Dec 15, 2022 4:26 pm กรุณาแนบไฟล์ตัวอย่างพร้อม Code มาด้วย อย่าลืมตัดมาเป็นตัวอย่างถามกันเฉพาะที่เป็นปัญหาดังที่กล่าวแล้วครับ

กรุณาทำตามด้านบนก่อนครับ

Posted: **Fri Dec 16, 2022 8:20 am**

โค๊ดช่วงนี้ สามารถปรับเปลี่ยนให้ดีกว่านี้ได้มั้ยครับ และเวลา Pasts ไปเจอเซลว่าง สามารถทำให้นับจากเซลที่ว่างต่อไปได้มั้ยครับ

Code: Select all

For i = 4 To 60000
            If dbbook.Sheets("BOM List").Range("B" & i).Value = mybook.Sheets("MainBOM").Range("N2").Value Then
            dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
            mybook.Sheets("MainBOM").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
            mybook.Sheets("MainBOM").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
            mybook.Sheets("MainBOM").Range("J" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AB" & i).Copy
            mybook.Sheets("MainBOM").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
            mybook.Sheets("MainBOM").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            dbbook.Sheets("BOM List").Range("AO" & i).Copy
            mybook.Sheets("MainBOM").Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            
            End If

Posted: **Fri Dec 16, 2022 12:41 pm**

หากมันทำงานได้ก็สามารถใช้ได้ครับ

่ส่วนตำแหน่งเซลล์ที่จะวางจะต้องหาคอลัมน์ที่เป็นตัวแทนโดยคอลัมน์นั้นจะต้องมีข้อมูลทุกเซลล์เพื่อไม่ให้วางผิดตำแหน่ง ตัวอย่างการปรับ Code เป็นด้านล่าง โดยใช้ Column A ของชีต MainBom เป็นตัวระบุค่าบรรทัดถัดไปที่จะวางข้อมูล

Code: Select all

'Other code...
Dim l As Long


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set mybook = ThisWorkbook

If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
    Set dbbook = Workbooks.Open("\\Lbox\meeting\EDS\New EDS\Confirm Spec\SX3000 ec\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
    
    mybook.Sheets("MainBOM").Range("A11:U500").ClearContents

     For i = 4 To 60000
        With dbbook.Sheets("MainBom")
            If dbbook.Sheets("BOM List").Range("B" & i).Value = .Range("N2").Value Then
               l = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
               dbbook.Sheets("BOM List").Range("K" & i, "L" & i).Copy
               .Range("A" & l).PasteSpecial xlPasteValuesAndNumberFormats
               dbbook.Sheets("BOM List").Range("N" & i, "T" & i).Copy
               .Range("C" & l).PasteSpecial xlPasteValuesAndNumberFormats
               dbbook.Sheets("BOM List").Range("W" & i, "Z" & i).Copy
               .Range("J" & l).PasteSpecial xlPasteValuesAndNumberFormats
               dbbook.Sheets("BOM List").Range("AB" & i).Copy
               .Range("N" & l).PasteSpecial xlPasteValuesAndNumberFormats
               dbbook.Sheets("BOM List").Range("AF" & i, "AL" & i).Copy
               .Range("O" & l).PasteSpecial xlPasteValuesAndNumberFormats
               dbbook.Sheets("BOM List").Range("AO" & i).Copy
               .Range("V" & l).PasteSpecial xlPasteValuesAndNumberFormats
            End If
         End With
     Next i
    dbbook.Close
'Other code...

Posted: **Fri Dec 16, 2022 2:40 pm**

ได้ตามต้องการเลยครับอาจารย์ แต่ตอน Run Code ถ้ามี Part เยอะ จะใช้เวลานาน เกิดจากการเขียนโค๊ดหรือป่าวครับ หรือว่าถึงจะเปลี่ยนวิธีการเขียนโค๊ด ก็ใช้เวลาเท่ากัน

Posted: **Fri Dec 16, 2022 3:07 pm**

ควรเปลี่ยนวิธีการเขียน Code ให้เก็บค่าเข้า Array แล้วค่อยวางทีเดียวครับ

ควรแนบไฟล์ต้นทางพร้อมช้อมูลตัวอย่างเพียงไม่กี่บรรทัดแล้วอธิบายว่าต้องการนำข้อมูลต้นทางจากตำแหน่งใดไปวางยังตำแหน่งใด ด้วยเงื่อนไขใด เพื่อจะได้สะดวกต่อการแนะนำของเพื่อนสมาชิกครับ

Posted: **Fri Dec 16, 2022 5:01 pm**

จากไฟล์แนบ MainBOM นำเข้าข้อมูลจาก BOM LIST NEW MODEL ครับ โดยที่ข้อมูลในเซล N2 ใน MainBOM และเซล B:B ใน BOM LIST NEW MODEL ตรงกัน ให้ดึงข้อมูลบางคอลัมภ์ (รายละเอียดตามโค๊ดเดิมใน MainBOM) มาวางใน MainBOM ครับ รบกวนแนะนำการใช้ Array ด้วยครับ

Posted: **Fri Dec 16, 2022 11:43 pm**

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

Code: Select all

Sub MainBOM()
    MsgBox "INPUT DATA NOW!!"
    
    Dim mybook As Workbook
    Dim i As Long
    Dim dbbook As Workbook
    Dim l As Long
    Dim aRs As Variant, aTg As Variant
    Dim rAll As Range, r As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set mybook = ThisWorkbook
    aRs = VBA.Split("K,L,N,O,P,Q,R,S,T,W,X,Y,Z,AB,AF,AH,AI,AJ,AK,AL,AO", ",")
    aTg = VBA.Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V", ",")
    
    If mybook.Sheets("MainBOM").Range("W3").Value = "SX3000ec" Then
        Set dbbook = Workbooks.Open("C:\Users\Lenovo\Desktop\EDS_BOM LIST SX3000 ec.xlsx", UpdateLinks:=False, ReadOnly:=True)
        mybook.Sheets("MainBOM").Range("A11:U500").ClearContents
        
        With dbbook.Worksheets("BOM List")
            Set rAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
        End With
        With mybook.Sheets("MainBom")
            For Each r In rAll
                If r.Value = .Range("n2").Value Then
                    l = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
                    For i = 0 To UBound(aRs)
                        .Range(aTg(i) & l).Value = r.Parent.Cells(r.Row, aRs(i)).Value
                    Next i
                End If
            Next r
        End With
        dbbook.Close
    End If
    Set dbbook = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
End Sub

อย่าลืมตรวจสอบตัวแปร aRs (คอลัมน์ต้นทาง) และ aTg (คอลัมน์ปลายทาง) ว่าประกอบด้วยคอลัมน์ตรงกับที่ใช้งานจริงแล้วหรือไม่ด้วยครับ

Posted: **Sat Dec 17, 2022 10:59 am**

ขอบคุณมากครับอาจารย์ เดี๋ยววันจันทร์จะลองทดสอบดูครับ

Posted: **Tue Dec 20, 2022 3:21 pm**

ใช้ได้ดีเลยครับ ประมวลผลได้เร็วดี ขอบคุณมากๆครับอาจารย์

Snasui Excel Forum

สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ

Re: สอบถามแนวทางการเขียน Code Copy VBA บางเซล ของ Excel หน่อยครับ