Snasui Excel Forum

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
Dim i As Long
With Sheets("การเบิก")
    For i = 100 To 1 Step -1
If .Range("h" & i).Value = "รับแล้ว" And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), .Range("h" & i).Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), .Range("h" & i).Offset(0, -6).Value) > 0 Then
            .Range("h" & i).Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next i
   With Sheets("การรับ")
 .Range("a3:h" & Application.CountIf(.Range("a3:a" & .Rows.Count), "<>") + 2).ClearContents
    End With
    For i = 1 To 100
If .Range("h" & i).Value = "รับแล้ว" Then
      .Range("h" & i).Offset(0, -7).Resize(1, 8).Copy
             With .Application.Sheets("การรับ")
               .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                   .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
       End If
    Next i
End With
End Sub

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
            r.Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next r
End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Button1_Click()
Application.ScreenUpdating = False
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
            r.Offset(0, -7).Resize(1, 8).Delete Shift:=xlUp
        End If
    Next r
End With
Application.ScreenUpdating = True
End Sub

Code: Select all

With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "รับแล้ว") And Application.CountIfs( _
            Worksheets("การรับ").Range("a3:a" & Rows.Count), r.Offset(0, -7).Value, _
            Worksheets("การรับ").Range("b3:b" & Rows.Count), r.Offset(0, -6).Value) = 0 Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With

Code: Select all

Sub Button14_Click()
Dim rAll As Range, r As Range
With Sheets("การเบิก")
    Set rAll = .Range("h3", .Range("h" & .Rows.Count).End(xlUp))
    For Each r In rAll
        If InStr(r, "ได้รับแล้ว") Then
            r.Offset(0, -7).Resize(1, 8).Copy
            With .Application.Sheets("การรับ")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
    Next r
End With
End Sub