Excel - VBA Zellen zwischen 1. und letzten Wert

Question

Ich versuche, VBA zu verwenden, um alle leeren Zellen in Zeilen mit dem Wert auf der linken Seite zu füllen, mit der Ausnahme, dass ich nur die leeren Zellen zwischen dem ersten und ausfüllen möchte letzter Wert in der Zeile (ohne Zeile 1 und Spalte A, die Bezeichner sind).

Ich hatte Probleme damit, die Schleife anzuhalten, sobald die letzte Spalte mit einem Wert erreicht wurde (dies ändert sich mit jeder Zeile), anstatt die letzte Spalte auf dem Blatt durchzugehen.

Ursprünglich wurde dies als Duplikat gekennzeichnet (Autofill when there are blank values), aber das löst das erwähnte Problem nicht. Dies wird fortgesetzt, bis das Blatt endet. Wie im Bild unten zu sehen ist, sollte die Füllung aufhören, wenn der letzte Wert erreicht ist.

Ich suche nach einer Lösung, die es mir ermöglicht, dies für ein ganzes Blatt auf einmal zu tun, obwohl die Daten in verschiedenen Spalten auf dem Blatt enden. Es gibt mehr als 1000 Reihen, so dass das Laufen für jede Reihe ziemlich mühsam sein kann.

Ich habe diesen Code verwendet, um die Daten (ohne die erste Zeile und Spalte) zu füllen. Aber ich bin mir nicht sicher, wie ich es beim letzten Wert in der Reihe stoppen kann.

Sub test() 
With ThisWorkbook.Sheets("Sheet1").Range("A:A") 
    With Range(.Cells(2, 2), .Cells(.Rows.Count, 36).End(xlUp)) 
     With .Offset(0, 1) 
      .Value = .Value 
      On Error Resume Next 
      .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]&""""" 
      On Error GoTo 0 
      .Value = .Value 
     End With 
    End With 
End With 
End Sub 

Wenn meine Erklärung nicht klar war, Dies ist ein Beispiel und die Ausgabe I

Ich danken Ihnen alle so viel im Voraus für Ihre Hilfe zu schaffen versuchen!

Answer 1

Und hier ist noch eine andere Lösung (nur Sie etwas Abwechslung geben):

Option Explicit 

Sub fillInTheBlanks() 

Dim lngRow As Long 
Dim ws As Worksheet 
Dim lngColumn As Long 
Dim bolStart As Boolean 
Dim lngLastColumn As Long 
Dim dblTempValue As Double 
Dim arrSheetCopy As Variant 

Set ws = ThisWorkbook.Worksheets("Sheet1") 
arrSheetCopy = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, ws.UsedRange.Columns.Count)).Value2 

For lngRow = LBound(arrSheetCopy, 1) To UBound(arrSheetCopy, 1) 
    bolStart = False 
    lngLastColumn = 0 
    For lngColumn = LBound(arrSheetCopy, 2) To UBound(arrSheetCopy, 2) 
     If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty Then lngLastColumn = lngColumn 
    Next lngColumn 
    For lngColumn = LBound(arrSheetCopy, 2) To lngLastColumn 
     If arrSheetCopy(lngRow, lngColumn) = vbEmpty And bolStart Then 
      arrSheetCopy(lngRow, lngColumn) = dblTempValue 
     Else 
      If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty And IsNumeric(arrSheetCopy(lngRow, lngColumn)) Then 
       bolStart = True 
       dblTempValue = CDbl(arrSheetCopy(lngRow, lngColumn)) 
      End If 
     End If 
    Next lngColumn 
Next lngRow 

ws.Range("A3").Resize(UBound(arrSheetCopy, 1), UBound(arrSheetCopy, 2)).Value2 = arrSheetCopy 

End Sub 

Dieses ist wahrscheinlich die schnellste Lösung (auch wenn es mit viel mehr Zeilen Code ein bisschen sperrig scheint im Vergleich zu den anderen Lösungen). Das liegt daran, dass diese Lösung die meiste Arbeit im Speicher und nicht auf dem Blatt erledigt. Das gesamte Blatt wird in eine Variable geladen, und dann wird die Arbeit an der Variablen ausgeführt, bevor das Ergebnis (die Variable) in das Blatt zurückgeschrieben wird. Wenn Sie also ein Geschwindigkeitsproblem haben, sollten Sie diese Lösung in Betracht ziehen.

Answer 2

Sie so etwas wie dies versuchen kann ...

Sub FillBlanks() 
Dim r As Long, lr As Long, lc As Long 
Dim cell As Range, FirstCell As Range, LastCell As Range 
lr = Cells(Rows.Count, 1).End(xlUp).Row 
lc = Cells(2, Columns.Count).End(xlToLeft).Column 
For r = 3 To lr 
    Set FirstCell = Range(Cells(r, 1), Cells(r, lc)).Find(what:="*", after:=Cells(r, 1)) 
    If Not FirstCell Is Nothing And FirstCell.Column > 1 Then 
     Set LastCell = Cells(r, Columns.Count).End(xlToLeft) 
     Range(FirstCell, LastCell).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]" 
     Range(FirstCell, LastCell).Value = Range(FirstCell, LastCell).Value 
    End If 
Next r 
End Sub 

Answer 3

Hier ist eine mögliche, die Ihre Beispieldaten die Erwartungen erfüllt.

Sub wqewqwew() 
    Dim i As Long, fc As Variant, lc As Long 

    'necessary if you do not want to confirm numbers and blanks in any row 
    On Error Resume Next 

    With ThisWorkbook.Worksheets("Sheet6") 
     For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row 
      If CBool(Application.Count(Rows(i))) Then 
       fc = Intersect(.Rows(i), .UsedRange).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1).Column 
       If Not IsError(fc) Then 
        lc = Application.Match(9^99, .Rows(i)) 
        On Error Resume Next 
        With .Range(.Cells(i, fc), .Cells(i, lc)) 
         .SpecialCells(xlCellTypeBlanks).Cells.FormulaR1C1 = "=RC[-1]" 
         .Value = .Value2 
        End With 
       End If 
      End If 
     Next i 
    End With 

End Sub 

Answer 4

Nur eine weitere Lösung:

Der folgende Code helfen kann, ist es müssen Sie die vorherigen Werte zwischen 1. und letzten Zellen je nach Wert der ersten Zelle Auto-füllen, wie in Frage Excel erwähnt - VBA füllen in Zellen zwischen 1. und letzter Wert

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Dim i As Long 
    For i = 2 To Target.Column 
     If Cells(Target.Row, i) = "" Then 
      If Cells(Target.Row, i - 1) <> "" Then 
       Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value 
      End If 
     End If 
    Next i 
End Sub 

Dieses Sub wird durch Klicken auf eine beliebige Zelle aktiviert. Die gleiche Zelle markiert das Ende der Schleife, d. H. Um die Schleife zu stoppen, klicken Sie einfach auf die Zelle, bis zu der die leeren Zellen gefüllt werden sollen.