/ / Dodaj wiele wartości w poleceniu IF THEN - excel, vba, excel-vba

Dodaj wiele wartości w instrukcji IF THEN - excel, vba, excel-vba

Jak dodać warunek, aby znaleźć wartości od 31 do 50 w tym kodzie. Mój kod działa doskonale tylko dla jednej wartości.

Private Sub CommandButton1_Click()

a = Worksheets("Test").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a
If Worksheets("Test").Cells(i, 10).Value = "30.00" Then
Worksheets("Test").Rows(i).Copy
Worksheets("Above").Activate
b = Worksheets("Above").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Above").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Test").Activate
End If
Next

Application.CutCopyMode = False

ThisWorkbook.Worksheets("Test").Cells(1, 1).Select

End Sub

Odpowiedzi:

2 dla odpowiedzi № 1

Oto inny sposób patrzenia na to. Używanie Unii to skuteczny sposób wklejania za jednym zamachem i wykonywania mniejszych obliczeń dla b.

Option Explicit

Private Sub CommandButton1_Click()

Dim a As Long
Dim b As Long
Dim i As Long
Dim unionRng As Range

With Worksheets("Test")

a = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
i = 2

If i > a Then Exit Sub

Dim currValue As Long "change if required

Do Until i = a

currValue =  .Cells(i, 10)

If currValue >= 31 And currValue <= 50 Then

If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, .Rows(i))
Else
Set unionRng = .Rows(i)
End If
End If
i = i + 1

Loop

End With

b = Worksheets("Above").Cells(Worksheets("Above").Rows.Count, 1).End(xlUp).Row

b = IIf(b = 1, 1, b + 1)

If Not unionRng Is Nothing Then

unionRng.Copy Worksheets("Above").Cells(b, 1)

End If

End Sub

1 dla odpowiedzi nr 2

Wypróbuj poniższy kod, aby znaleźć wartości od 31 do 50.

Uwaga: nie ma takiej potrzeby Activate i Select, po prostu użyj w pełni kwalifikowanych obiektów, jak w poniższym kodzie.

Kod

Option Explicit

Private Sub CommandButton1_Click()

Dim a As Long, b As Long, i As Long

With Worksheets("Test")
a = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = 2 To a
If .Cells(i, 10).Value >= 31 And .Cells(i, 10).Value <= 50 Then
b = Worksheets("Above").Cells(Worksheets("Above").Rows.Count, 1).End(xlUp).Row " get last row in "Above" sheet

" copy >> paste in 1-line withou using Select
.Rows(i).Copy Destination:=Worksheets("Above").Cells(b + 1, 1)
End If
Next
End With

Application.CutCopyMode = False

End Sub

1 dla odpowiedzi nr 3

lub możesz użyć AutoFilter()

Private Sub CommandButton1_Click()
With Worksheets("Test")
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
.AutoFilter Field:=1, Criteria1:=">=31", Operator:=xlAnd, Criteria2:="<=50"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Intersect(.parent.UsedRange, .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).copy Destination:=Worksheets("Above").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
.AutoFilterMode = False
End With
End Sub