สอบถามการใช้ If 2 เงื่อนไข

[lnongkungl]

สวัสดีครับอาจารย์ และ ผู้เชี่ยวชาญทุกท่านครับ วันนี้ผมมาขอแนวทางการใช้ If ใน vba ครับ เพื่อที่จะได้ไปลองเขียนดูก่อนแล้วถ้าติดตรงไหนจะมาถามอีกทีครับ

ปกติ If ก็จะมีเงื่อนไขเดียว เช่น

Code: Select all

If 2 > 0 Then
MsgBox "Yes"
End If

รูปแบบการเขียนก็จะประมาณนี้ถูกต้องนะครับ แต่ถ้ามี 2 เงื่อนไข ก่อนที่จะไป then ครับ ต้องเขียนยังไง ผมพยายามหาวิธีการเขียนจากเว็บแล้ว หาไม่เจอจริงๆครับ

ประมาณนี้ครับ

Code: Select all

.
.
.
If range("a") =>0 & range("b")<100 then
range("c").copy
.
.
.

รบกวนขอแนวทางการเขียนว่าต้องใช้ code ประมาณไหนด้วยครับ ผมลองมั่วๆ ดูแล้วไม่ได้จริงๆ แล้วผมจะลองเขียนดูถ้าติดอะไรจะแนบไฟล์และ Code ที่ลองเขียนมาสอบถามอีกครั้งครับ

[snasui]

Code: Select all

If range("a") =>0 & range("b")<100 then
range("c").copy

เขียนด้วยเงื่อนไขนี้ก็ใช้ได้เพียงแต่ Statement ไม่ถูกต้องเท่านั้น การอ้างอิงเซลล์ต้องระบุเป็นเช่น range("a1"), range("b1") เป็นต้น ไม่ใช่ range("a"), range("b") ครับ

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

[lnongkungl]

concept คือ จะดึงข้อมูลใน sheet Data มาแสดงใน sheet Show โดยมีเงื่อนไข 2 ตัวคือ order id และ order no. ภายใน if แรกคือ ถ้าใส่เงื่อนไขตัวเดียวคือ order id (ปล่อยเงื่อนไขที่ 2 ว่าง)ก็ให้ดึงข้อมูลที่เป็น order id นั้นมาทั้งหมด แต่หลัง else คือ ถ้าใส่เงื่อนไข 2 ตัว ก็จะให้ดึงมาเฉพาะที่เป็น order id และ order no. นั้นมาครับ

ผมใส่ & ไปก็ไม่เกิดผลลัพธ์อะไรออกมา ใส่ , ก็ error ครับ

Code: Select all

Sub collectNO()

Dim i As Long
Dim desRow As Long
Dim a As Range, b As Range
Set a = Sheets("Show").Range("G1")
Set b = Sheets("Show").Range("G2")

If b.Value = "" Then
Application.ScreenUpdating = False
    For i = 2 To Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
        If Sheets("Data").Range("A" & i).Value = a.Value Then
            destRow = Sheets("Show").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Data").Range("A" & i & ":B" & i).Copy
            Sheets("Show").Range("A" & destRow).PasteSpecial xlPasteValues
    
            Sheets("Data").Range("G" & i).Copy
            Sheets("Show").Range("C" & destRow).PasteSpecial xlPasteValues
        End If
    Next i
Else
    For i = 2 To Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    'บรรทัดนี้ครับใส่ If 2 เงื่อนไขก่อนไป then
        If Sheets("Data").Range("A" & i).Value = a.Value & Sheets("Data").Range("B" & i).Value = b.Value Then
            destRow = Sheets("Show").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Data").Range("A" & i & ":B" & i).Copy
            Sheets("Show").Range("A" & destRow).PasteSpecial xlPasteValues
    
            Sheets("Data").Range("G" & i).Copy
            Sheets("Show").Range("C" & destRow).PasteSpecial xlPasteValues
        End If
    Next i
MsgBox "เพิ่ม Code 2 เงื่อนไข"
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

[snasui]

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

Code: Select all

Sub collectNO()
    Dim i As Long
    Dim desRow As Long
    Dim a As Range, b As Range
    Set a = Sheets("Show").Range("G1")
    Set b = Sheets("Show").Range("G2")
    Dim strF As String, strCp As String
    
    Application.ScreenUpdating = False

    With Sheets("Data")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If a.Value <> "" And b.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value & "_" & .Range("b" & i).Value
            ElseIf a.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value
            ElseIf b.Value <> "" Then
                strF = ab.Value
                strCp = .Range("b" & i).Value
            End If
            If strF = strCp Then
                If .Range("A" & i).Value = a.Value Then
                    destRow = Sheets("Show").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Application.Union(.Range("a" & i), .Range("b" & i), .Range("g" & i)).Copy
                    Sheets("Show").Range("a" & destRow).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                End If
            End If
        Next i
    End With
    MsgBox "เพิ่ม Code 2 เงื่อนไข"
    Application.ScreenUpdating = True
End Sub

[lnongkungl]

ผลลัพธ์ 2 เงื่อนไขออกครับ แต่แบบใส่แค่เงื่อนไขแรก a กลับไม่มีอะไรออกมาเลย

ผลเลยลองเอา code ที่ผมเขียนตอนแรก เข้ามาคั่นใน if แรก ผลปรากฏว่า ไม่ error แต่ก็ไม่มีผลลัพธ์ออกมาเช่นกัน

รบกวนอาจารย์อีกทีครับ

[snasui]

จาก Code นี้

Code: Select all

ElseIf a.Value <> "" Then
	strF = a.Value & "_" & b.Value
	strCp = .Range("a" & i).Value
ElseIf b.Value <> "" Then
	strF = ab.Value
	strCp = .Range("b" & i).Value
End If

ปรับเป็นด้านล่างครับ

Code: Select all

ElseIf a.Value <> "" Then
	strF = a.Value
	strCp = .Range("a" & i).Value
ElseIf b.Value <> "" Then
	strF = b.Value
	strCp = .Range("b" & i).Value
End If

กรุณาทำความเข้าใจและฝึก Debug Code ด้วยตนเอง จะได้หาสาเหตุของความผิดพลาดได้ครับ

[lnongkungl]

ขออภัยครับ เพราะผมยังไม่ชำนาญเท่าไรครับ แค่พอไปได้ เจอ code ลึกๆ ก็ งง เหมือนกัน

ก่อนมาเห็นที่อาจารย์ตอบ ผมปรับเป็นแบบนี้ครับ ก็ได้ผลลัพธ์ตามต้องการ

แต่เหมือน code มันจะซ้ำซ้อนไปหน่อย

Code: Select all

Sub collectNO()
    Dim i As Long
    Dim k As Long
    Dim desRow As Long
    Dim a As Range, b As Range
    Set a = Sheets("Show").Range("G1")
    Set b = Sheets("Show").Range("G2")
    Dim strF As String, strCp As String
    
    Application.ScreenUpdating = False

    With Sheets("Data")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If a.Value <> "" And b.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value & "_" & .Range("b" & i).Value
            ElseIf a.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value
            ElseIf b.Value <> "" Then
                strF = ab.Value
                strCp = .Range("b" & i).Value
            End If
            
            If b.Value = "" Then
                     If Sheets("Data").Range("A" & i).Value = a.Value Then
                        destRow = Sheets("Show").Range("A" & Rows.Count).End(xlUp).Row + 1
                        Sheets("Data").Range("A" & i & ":B" & i).Copy
                        Sheets("Show").Range("A" & destRow).PasteSpecial xlPasteValues
    
                        Sheets("Data").Range("G" & i).Copy
                        Sheets("Show").Range("C" & destRow).PasteSpecial xlPasteValues
                     End If
        ElseIf strF = strCp Then
                If .Range("A" & i).Value = a.Value Then
                    destRow = Sheets("Show").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Application.Union(.Range("a" & i), .Range("b" & i), .Range("g" & i)).Copy
                    Sheets("Show").Range("a" & destRow).PasteSpecial xlPasteValues
                     Application.CutCopyMode = False
                End If
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

[snasui]

ปรับ Code ตามที่ผมตอบในโพสต์ #6 ติดตรงไหนค่อยนำมาถามกันต่อครับ

[lnongkungl]

ปัญหาใหม่ครับ เมื่อทดสอบแยก workbook ผมเพิ่ม code เจอ error ไล่ F8 เช็คทีละบรรทัด จนไม่มี error แล้วครับ

แต่ผลลัพธ์ไม่ออก เปิดไฟล์ที่มี Data อยู่ได้ แต่ไม่ดึงข้อมูลมาวางใน workbook ที่ run code ครับ

Code: Select all

Sub collectNO2()
    Dim wb As Workbook, wbf As Workbook
    Dim wn As Range
    Dim nsh As Range
    Dim i As Long
    Dim desRow As Long
    Dim a As Range, b As Range
    Dim strF As String, strCp As String
    Set a = Sheets("Show").Range("G1")
    Set b = Sheets("Show").Range("G2")
    Set wn = Range("I1")
    Set nsh = Range("I2")
    Set wbf = ThisWorkbook
        
    
    Application.ScreenUpdating = False
    Set wb = Application.Workbooks.Open(Filename:=wn.Value, ReadOnly:=True)
    With wb.Sheets(nsh.Value)
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If a.Value <> "" And b.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value & "_" & .Range("b" & i).Value
            ElseIf a.Value <> "" Then
                strF = a.Value
                strCp = .Range("a" & i).Value
            ElseIf b.Value <> "" Then
                strF = ab.Value
                strCp = .Range("b" & i).Value
            End If
            If strF = strCp Then
                If .Range("A" & i).Value = a.Value Then
                    With wbf.Sheets("Show")
                        destRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        Application.Union(.Range("a" & i), .Range("b" & i), .Range("g" & i)).Copy
                        .Range("a" & destRow).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    End With
                End If
            End If
        Next i
    End With
  
    Application.ScreenUpdating = True
End Sub

[snasui]

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

Code: Select all

'Other code
If strF = strCp Then
    With wbf.Sheets("Show")
        destRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
        Application.Union(wb.Sheets(nsh.Value).Range("a" & i), _
            wb.Sheets(nsh.Value).Range("b" & i), _
            wb.Sheets(nsh.Value).Range("g" & i)).Copy
        .Range("a" & destRow).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End If
'Other code

[lnongkungl]

ผลลัพธ์ถูกต้องครับ และผมได้เพิ่ม on error goto เข้าไป ก็ได้ผลเมื่อใส่ชื่อไฟล์ผิด (หาวิธีใช้ on error อยู่นานกว่าจะเข้าใจ)

ทีนี้มาติดตรงที่ว่า ถ้าเงื่อนไขแรกที่ค้นหา (คือข้อมูลใน column A) ไม่ได้เป็นแค่ตัวเลขอย่างเดียว เช่น 1024(ก) , A1011(ยน) แบบนี้ครับ แต่เราไม่รู้ว่า ข้างหน้า หรือ ข้างหลังเลขที่เราจะค้นหาเป็นตัวอะไรบ้าง เราจะกำหนดได้มั้ยครับว่าให้ใช้แค่ตัวเลข แต่สามารถค้นหามาได้ทั้งหมด เช่น

ต้องการค้นหา เลข 1011 เมื่อ run code แล้วจะได้ผลลัพธ์เป็น
1011
1011(ก)
1011(12)
1011
ฺB1011

ประมาณนี้ครับ

ผมพยายามหาวิธีปรับแล้วใน goole แต่หาไม่เจอจริงๆครับ หรือผมอาจจะใช้ keyword ในการค้นหาไม่ถูกกับโจทย์ เลยหาไม่เจอซักที

Code: Select all

Sub collectNO2()
    Dim wb As Workbook, wbf As Workbook
    Dim wn As Range
    Dim nsh As Range
    Dim i As Long
    Dim desRow As Long
    Dim a As Range, b As Range
    Dim strF As String, strCp As String
    Set a = Sheets("Show").Range("G1")
    Set b = Sheets("Show").Range("G2")
    Set wn = Range("I1")
    Set nsh = Range("I2")
    Set wbf = ThisWorkbook
        
    
    Application.ScreenUpdating = False
    On Error GoTo err1:
    Set wb = Application.Workbooks.Open(Filename:=wn.Value, ReadOnly:=True)
    With wb.Sheets(nsh.Value)
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If a.Value <> "" And b.Value <> "" Then
                strF = a.Value & "_" & b.Value
                strCp = .Range("a" & i).Value & "_" & .Range("b" & i).Value
            ElseIf a.Value <> "" Then
                strF = a.Value
                strCp = .Range("a" & i).Value
            ElseIf b.Value <> "" Then
                strF = ab.Value
                strCp = .Range("b" & i).Value
            End If
            If strF = strCp Then
               'If .Range("A" & i).Value Like a.Value Then
                    With wbf.Sheets("Show")
                        destRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        Application.Union(wb.Sheets(nsh.Value).Range("a" & i), _
                            wb.Sheets(nsh.Value).Range("b" & i), _
                            wb.Sheets(nsh.Value).Range("g" & i)).Copy
                        .Range("a" & destRow).PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    End With
               ' End If
            End If
        Next i
    End With
    
   wb.Close False
    Application.ScreenUpdating = True
Exit Sub
err1:
        MsgBox "ไม่พบข้อมูลที่ค้นหา หรือ ใส่ที่อยู่ไฟล์ , ชื่อไฟล์ ผิด!!!", vbCritical, "SK-FOODS"
End Sub

[snasui]

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

Code: Select all

'Other code
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
    If a.Value <> "" And b.Value <> "" Then
        strF = "*" & a.Value & "*" & b.Value & "*"
        strCp = .Range("a" & i).Value & "*" & .Range("b" & i).Value
    ElseIf a.Value <> "" Then
        strF = "*" & a.Value & "*"
        strCp = .Range("a" & i).Value
    ElseIf b.Value <> "" Then
        strF = "*" & b.Value & "*"
        strCp = .Range("b" & i).Value
    End If
    If strCp Like strF Then
        With wbf.Sheets("Show")
            destRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            Application.Union(wb.Sheets(nsh.Value).Range("a" & i), _
                wb.Sheets(nsh.Value).Range("b" & i), _
                wb.Sheets(nsh.Value).Range("g" & i)).Copy
            .Range("a" & destRow).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    End If
Next i
'Other code

ในโอกาสถัดไปกรุณาแนบไฟล์ที่ได้ปรับ Code ล่าสุดมาแล้วด้วยจะได้สะดวกในการตอบของเพื่อนสมาชิกครับ