การวนลูป

aapichaya · #1

อยากสอบถามโค้ดลูป 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

eyepop99 · #2

ปรับเป็น

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

aapichaya · #3

ได้เเล้วค่ะ ขอบคุณมากค่ะ รบกวนดูอีก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

eyepop99 · #4

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

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

puriwutpokin · #5

ลองปรับเป็น

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

aapichaya · #6

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

puriwutpokin · #7

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

eyepop99 · #8

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

แปลว่า ECR NO จะมีวันที่เดียวกันทั้งหมด ถูกต้องไหมครับ

aapichaya · #9

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 เดียวกันก็จะมีวันที่เดียวกันค่ะ

puriwutpokin · #10

ลองดูครับว่าใช่ไหม

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

eyepop99 · #11

ปรับตามนี้นะครับ น่าจะใช้ได้แล้ว ผมลองรันแล้ว ผ่าน

ปล. 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

puriwutpokin · #12

แก้ปัญหา 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

aapichaya · #13

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

ขอบคุณมากค่ะ

aapichaya · #14

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

โอเคค่ะ ขอบคุณมากค่ะ

aapichaya · #15

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

ขอบคุณมากค่ะ

Snasui Excel Forum

File Anatomy Add-in: ตรวจสอบโครงสร้างไฟล์ Excel อย่างมืออาชีพ

การวนลูป

การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป

Re: การวนลูป