Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

การวนลูป

https://www.snasui.com/viewtopic.php?t=12800

Page 1 of 1

การวนลูป

Posted: Wed Jan 24, 2018 2:10 pm
by aapichaya
อยากสอบถามโค้ดลูป for...Next ค่ะ พอดีเขียนเเล้วเเต่เหมือนว่าไม่ได้วนลูปจนจบไม่แน่ใจว่าเป็นเพราะว่าจำนวนรอบไม่เเน่นอนจึงทำให้ลูปไม่ทำงานหรือไม่

Code: Select all

Sub test()

 Dim x As Integer, NumRows As Integer
On Error Resume Next
  Application.ScreenUpdating = False
            NumRows = Range("C4", Range("C4").End(xlDown)).Rows.Count
                       Range("C4").Select
         
 For x = 3 To NumRows
                            
                     If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       Else
                    Cells(x, 47).Value = Cells(x, 3)
          End If
          Cells(x, 3).Offset(1, 0).Select
          
 'x = x + 1
 Next x

 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Wed Jan 24, 2018 2:39 pm
by eyepop99
ปรับเป็น

Code: Select all

Sub test()

 Dim x As Integer, NumRows As Integer
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
        
 For x = 3 To NumRows
                            
                     If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       Else
                    Cells(x, 47).Value = Cells(x, 3)
          End If
          Cells(x, 3).Offset(1, 0).Select
          
 'x = x + 1
 Next x

 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 9:52 am
by aapichaya
ได้เเล้วค่ะ ขอบคุณมากค่ะ รบกวนดูอีกModule(Module1) ให้ด้วยได้ไหมคะ คิดว่าติดปัญหาตรง vlookup ค่ะ

Code: Select all

Sub test2()

Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").range("A3").End(xlDown).Row
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .range("B3", .range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
        
 For x = 3 To NumRows
                            
                             If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 48).Value = Cells(x, 37)
                   
                             ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 48).Value = Cells(x, 37)
                    
                             ElseIf Cells(x, 3).Value = "Drawing Release" Then
        Cells(x, 48).Value = Cells(x, 37)
                    
                    ElseIf Cells(x, 37) = "" Then
                           If Cells(x, 3) = "ECR Approval" Then
            Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), range("A3:AK" & l), 33, 0)
              End If
                              Else
                              Cells(x, 48).Value = Cells(x, 37)
                       
                              
          End If
  
          

 Next x

 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 10:37 am
by eyepop99
เท่าที่ดู code นะครับ
-ไม่มีทางไหนเลย ที่จะเข้า If ที่เป็น Vlookup เนื่องจากว่า ที่ Cells(x,3) ไม่มีช่องใดว่าง เพราะฉะนั้นCode จะข้ามเงื่อนไข cells(x,37) ไป
-ส่วนการใช้ vlookup เงื่อนไขการใช้ vlookup จะดึงค่าที่เจอค่าแรกเสมอซึ่งทำให้ข้อมูลที่ดึงมาผิดพลาด ครับ
เพราะ เมื่อ vlookup เจอ จะนำค่าแรกมาเสมอ ถ้าต้องการจะใช้ vlookup ข้อมูลที่ lookup นั้นควรเป็นค่าไม่ซ้ำ ครับ

รบกวนเขียนเงื่อนไขที่ต้องการเพื่อช่วยแก้ปัญหาครับ

Re: การวนลูป

Posted: Thu Jan 25, 2018 10:45 am
by puriwutpokin
ลองปรับเป็น

Code: Select all

Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").range("A3").End(xlDown).Row
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .range("B3", .range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                             If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "Drawing Release" Then
        Cells(x, 48).Value = Cells(x, 37)
                    ElseIf Cells(x, 37) = "" Then
                           If Cells(x, 3) = "ECR Approval" Then
            Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), range("C3:AK" & l), 35, 0)
              End If
                              Else
                              Cells(x, 48).Value = Cells(x, 37)
          End If
 Next x
 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 11:54 am
by aapichaya
เงื่อนไข คือต้องการดึงsend out date จาก parent enty ที่มีค่าเป็น ECR Approval,DCN Approval,Drawing Release มาวางในตัวที่มี ECR NO เดียวกันค่ะ (รบกวนดูไฟล์เเนบค่ะ)

Re: การวนลูป

Posted: Thu Jan 25, 2018 12:35 pm
by puriwutpokin
aapichaya wrote: Thu Jan 25, 2018 11:54 am เงื่อนไข คือต้องการดึงsend out date จาก parent enty ที่มีค่าเป็น ECR Approval,DCN Approval,Drawing Release มาวางในตัวที่มี ECR NO เดียวกันค่ะ (รบกวนดูไฟล์เเนบค่ะ)
ลองดูโค้ดนี้ครับ ผมงง กับ โค้ดเก่าและคำถามไม่ค่อยเข้าใจครับลองดูละกันครับ ว่าใช่ไหม

Code: Select all

Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").Range("A3").End(xlDown).Row
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                             If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "Drawing Release" Then
                   Cells(x, 48).Value = Cells(x, 37)
                   ' ElseIf Cells(x, 37) = "" Then
                         '  If Cells(x, 3) = "ECR Approval" Then
     '       Cells(x, 48) = Application.WorksheetFunction.VLookup(Cells(x, 3), Range("C3:AK" & l), 35, 0)
        '      End If
                             ' Else
                         '     Cells(x, 48).Value = Cells(x, 37)
          End If
 Next x
 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 1:38 pm
by eyepop99
aapichaya wrote: Thu Jan 25, 2018 11:54 am เงื่อนไข คือต้องการดึงsend out date จาก parent enty ที่มีค่าเป็น ECR Approval,DCN Approval,Drawing Release มาวางในตัวที่มี ECR NO เดียวกันค่ะ (รบกวนดูไฟล์เเนบค่ะ)
แปลว่า ECR NO จะมีวันที่เดียวกันทั้งหมด ถูกต้องไหมครับ

Re: การวนลูป

Posted: Thu Jan 25, 2018 2:29 pm
by aapichaya
eyepop99 wrote: Thu Jan 25, 2018 1:38 pm
aapichaya wrote: Thu Jan 25, 2018 11:54 am เงื่อนไข คือต้องการดึงsend out date จาก parent enty ที่มีค่าเป็น ECR Approval,DCN Approval,Drawing Release มาวางในตัวที่มี ECR NO เดียวกันค่ะ (รบกวนดูไฟล์เเนบค่ะ)
แปลว่า ECR NO จะมีวันที่เดียวกันทั้งหมด ถูกต้องไหมครับ
ใช่ค่ะ ECR NO เดียวกันจะมีวันที่เดียวกันค่ะ
จากภาพ Row3และ 4มี ECR No เดียวกัน ดังนั้นในช่อง send out date 1 ในRow4ต้องเป็นวันที่ 11-Jan-18
เช่นเดียวกับRow5-7 ที่มี ECR No เดียวกันก็จะมีวันที่เดียวกันค่ะ
Image

Re: การวนลูป

Posted: Thu Jan 25, 2018 2:33 pm
by puriwutpokin
ลองดูครับว่าใช่ไหม

Code: Select all

Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").Range("A3").End(xlDown).Row
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                             If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "Drawing Release" Then
                   Cells(x, 48).Value = Cells(x, 37)
        ElseIf Cells(x, 3) <> "" And Cells(x, 37) = "" Then
            Cells(x, 48).Select
            Selection.FillDown
     End If
 Next x
 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 5:02 pm
by eyepop99
ปรับตามนี้นะครับ น่าจะใช้ได้แล้ว ผมลองรันแล้ว ผ่าน

ปล. item ที่ 25และ26 ผลลัพธ์ไม่เหมือนตัวอย่างที่ให้มา เพราะว่า ERC NO นั้น VLOOKUp ตรวจพบ เท่ากับวันที่ 16-jan-18 เป็นตัวแรก
จะได้ผลลัพธ์เท่ากับ 16-jan-18
แต่ตัวอย่างผลลัพธ์ที่ได้ จะเท่ากับ 4-Jan-18

Code: Select all

Sub test()

 Dim x As Integer, NumRows As Integer
 Dim l As Integer
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
        
 For x = 3 To NumRows
                            
                     If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       Else
                    Cells(x, 47).Value = Cells(x, 3)
          End If
          Cells(x, 3).Offset(1, 0).Select
          
 'x = x + 1
 Next x
l = Worksheets("Sheet1").Range("A2").End(xlDown).Row
For x = 3 To NumRows

With ActiveSheet

          .Cells(x, 48).Value = Application.IfError(Application.VLookup(.Cells(x, 47).Value, .Range("E:AK"), 33, 0), "")

End With
 Next x

 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Thu Jan 25, 2018 7:39 pm
by puriwutpokin
แก้ปัญหา Vlookup โดยวิธีนี้ดูครับ

Code: Select all

Sub test3()
Dim x As Integer, NumRows As Integer
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                    If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   Cells(x, 48).Value = Cells(x, 37)
                   Cells(x, 48).Offset(1, 0).FillDown
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    Cells(x, 48).Value = Cells(x, 37)
                    Cells(x, 48).Offset(1, 0).FillDown
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    Cells(x, 48).Value = Cells(x, 37)
                    Cells(x, 48).Offset(1, 0).FillDown
       Else
                    Cells(x, 47).Value = Cells(x, 3)
             If Cells(x, 47).Value <> "" Then
                    Cells(x, 48).Offset(1, 0).FillDown
                    Else
                    Cells(x, 48).Value = ""
     End If
    End If
 Next x
 Application.ScreenUpdating = True
End Sub

Re: การวนลูป

Posted: Fri Jan 26, 2018 7:48 am
by aapichaya
puriwutpokin wrote: Thu Jan 25, 2018 2:33 pm ลองดูครับว่าใช่ไหม

Code: Select all

Sub test2()
Dim x As Integer, NumRows As Integer
Dim l As Integer
l = Worksheets("Sheet1").Range("A3").End(xlDown).Row
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                             If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 48).Value = Cells(x, 37)
                             ElseIf Cells(x, 3).Value = "Drawing Release" Then
                   Cells(x, 48).Value = Cells(x, 37)
        ElseIf Cells(x, 3) <> "" And Cells(x, 37) = "" Then
            Cells(x, 48).Select
            Selection.FillDown
     End If
 Next x
 Application.ScreenUpdating = True
End Sub
ขอบคุณมากค่ะ

Re: การวนลูป

Posted: Fri Jan 26, 2018 7:49 am
by aapichaya
eyepop99 wrote: Thu Jan 25, 2018 5:02 pm ปรับตามนี้นะครับ น่าจะใช้ได้แล้ว ผมลองรันแล้ว ผ่าน

ปล. item ที่ 25และ26 ผลลัพธ์ไม่เหมือนตัวอย่างที่ให้มา เพราะว่า ERC NO นั้น VLOOKUp ตรวจพบ เท่ากับวันที่ 16-jan-18 เป็นตัวแรก
จะได้ผลลัพธ์เท่ากับ 16-jan-18
แต่ตัวอย่างผลลัพธ์ที่ได้ จะเท่ากับ 4-Jan-18

Code: Select all

Sub test()

 Dim x As Integer, NumRows As Integer
 Dim l As Integer
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
        
 For x = 3 To NumRows
                            
                     If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    
       Else
                    Cells(x, 47).Value = Cells(x, 3)
          End If
          Cells(x, 3).Offset(1, 0).Select
          
 'x = x + 1
 Next x
l = Worksheets("Sheet1").Range("A2").End(xlDown).Row
For x = 3 To NumRows

With ActiveSheet

          .Cells(x, 48).Value = Application.IfError(Application.VLookup(.Cells(x, 47).Value, .Range("E:AK"), 33, 0), "")

End With
 Next x

 Application.ScreenUpdating = True
End Sub
โอเคค่ะ ขอบคุณมากค่ะ

Re: การวนลูป

Posted: Fri Jan 26, 2018 7:50 am
by aapichaya
puriwutpokin wrote: Thu Jan 25, 2018 7:39 pm แก้ปัญหา Vlookup โดยวิธีนี้ดูครับ

Code: Select all

Sub test3()
Dim x As Integer, NumRows As Integer
On Error Resume Next
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
            NumRows = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Rows.Count
    NumRows = NumRows + 2
 End With
 For x = 3 To NumRows
                    If Cells(x, 3).Value = "ECR Approval" Then
                   Cells(x, 47).Value = Cells(x, 5)
                   Cells(x, 48).Value = Cells(x, 37)
                   Cells(x, 48).Offset(1, 0).FillDown
       ElseIf Cells(x, 3).Value = "DCN Approval" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    Cells(x, 48).Value = Cells(x, 37)
                    Cells(x, 48).Offset(1, 0).FillDown
       ElseIf Cells(x, 3).Value = "Drawing Release" Then
                    Cells(x, 47).Value = Cells(x, 5)
                    Cells(x, 48).Value = Cells(x, 37)
                    Cells(x, 48).Offset(1, 0).FillDown
       Else
                    Cells(x, 47).Value = Cells(x, 3)
             If Cells(x, 47).Value <> "" Then
                    Cells(x, 48).Offset(1, 0).FillDown
                    Else
                    Cells(x, 48).Value = ""
     End If
    End If
 Next x
 Application.ScreenUpdating = True
End Sub
ขอบคุณมากค่ะ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited