Do Until ... Loop Schleife

Question

Hallo Alle zusammen.

Wer kann bitte  helfen, ich habe folgendes Problem:

In einer Spalte stehen numerische Werte von 1 bis 12. Die Werte kommen mehrfach vor.

Meine Schleife zählt aber nur bis zur ersten Zahl. Ist der Wert gefunden wird der Suchvorgang nicht in den darunterliegenden Zellen fortgesetzt.

Die Tabelle besteht aus 60 Zeilen . Die Zahlen stehen in der Spalte BR  ab Zelle  "BR6"

Ich nutze EXCEL 2007 VBA

Ich kopiere mal meine momentanen Arbeitsstand:

Dim i As Integer

    Dim ws As Worksheet

   Dim rng As Range

Windows("AnteilswertBilanz_Monate.xlsm").Activate

Sheets("Ein-Ausz ").Select

      Range("BR1").Select

   '  --------------------------------------------------------------

  Set rng = ActiveCell.Offset(0, 0)

     i = 1

   Do Until i = 0 Or rng.Offset(i, 0).Value2 = "1"

    i = i + 1

      If i = 55 Then

Exit Do

End If

Loop

'-----Zellen kopieren und einfügen----------------------------------

  'ActiveCell.Offset(i, 1) = "1"

   If ActiveCell.Offset(i, 0) = "1" Then

 ActiveCell.Offset(i, 1) = 1

 ActiveCell.Offset(i, 3) = 1

 ActiveCell.Offset(i, 4) = 1

 ActiveCell.Offset(i, 5) = 1

 ActiveCell.Offset(i, 6) = 1

 ActiveCell.Offset(i, 7) = 1

 ActiveCell.Offset(i, 8) = 1

 ActiveCell.Offset(i, 9) = 1

 ActiveCell.Offset(i, 10) = 1

 ActiveCell.Offset(i, 11) = 1

 ActiveCell.Offset(i, 12) = 1

 ActiveCell.Offset(i, 13) = 1

 ActiveCell.Offset(i, 14) = 1

 ActiveCell.Offset(i, 15) = 1

 ActiveCell.Offset(i, 16) = 1

 ActiveCell.Offset(i, 17) = 1

 ActiveCell.Offset(i, 18) = 1

 ActiveCell.Offset(i, 19) = 1

 ActiveCell.Offset(i, 20) = 1

 ActiveCell.Offset(i, 21) = 1

 ActiveCell.Offset(i, 22) = 1

 ActiveCell.Offset(i, 23) = 1

 ActiveCell.Offset(i, 24) = 1

  End If

End Sub

Answer 1

Hallo Albrecht,

wenn du nach einer Zahl suchst, darfst du sie nicht in Anführungszeichen setzen, sonst ist es Text 1. Außerdem kannst du die ganzen Spalten als ein Bereich ansprechen und auf einen Rutsch füllen:

Sub Test()

Dim i As Long

With Workbooks("AnteilswertBilanz_Monate.xlsm").Sheets("Ein-Ausz ")

    lrow = Cells(Rows.Count, "BR").End(xlUp).Row

    For i = 6 To lrow

        If .Cells(i, "BR") = 1 Then

            .Cells(i, "BR").Offset(, 1).Resize(columnsize:=24) = 1

        End If

    Next

End With

End Sub

Mit freundlichen Grüßen

Claus

Answer 2

Hallo Claus,

danke , ich habe es sogleich getestet, es funktioniert.

Auch das Ausfüllen der Zeile ist eine große Hilfe. Werde das Ganze noch mal durchdenken.

MFG

Albrecht