/ / Hinzufügen mehrerer Werte in der IF THEN-Anweisung - Excel, Vba, Excel-Vba

Fügen Sie mehrere Werte in der IF THEN-Anweisung hinzu - excel, vba, excel-vba

Wie füge ich eine Bedingung hinzu, um Werte von 31 bis 50 in diesem Code zu finden? Mein Code funktioniert nur für einen Wert.

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

Antworten:

2 für die Antwort № 1

Hier ist eine andere Sichtweise. Die Verwendung von Union ist eine effiziente Methode zum Einfügen in einem Arbeitsgang, und Sie müssen weniger Berechnungen für b durchführen.

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 für die Antwort № 2

Verwenden Sie den folgenden Code, um Werte zwischen 31 und 50 zu finden.

Hinweis: Es besteht keine Notwendigkeit Activate und SelectVerwenden Sie nur vollständig qualifizierte Objekte, wie im folgenden Code.

Code

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 für die Antwort № 3

oder du könntest es benutzen 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