Snasui Excel Forum

Code: Select all

If 2 > 0 Then
MsgBox "Yes"
End If

Code: Select all

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

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

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

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

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

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

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

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

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