循环代码直到 excel 中的单元格为空

Question

我遇到了这个问题：
我有这段代码，它可以工作，但我现在很挣扎。
我想要循环整个代码，直到 Table1 单元格 D1 为空。

 Sub strule()
 
    Dim myCellRange As Range
 

   Worksheets("Table1").Select                                         

 Code = Range("D1")

   Wert = Range("E10")

    Worksheets("Table2").Select
    Worksheets("Table2").Range("A1").Select
      
      lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row                   
  Range("A" & lMaxRows).Select


    ActiveCell.Offset(1, 0).Select                                         
    ActiveCell.Value = Code
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Wert
    
 
    Sheets("Table1").Select                                         '
    Rows("1:10").Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp


End Sub

Answer 1

我已经猜到你想要什么了……不过可能完全错了。

首先，您的原始代码已删除所有选择和激活：

Sub strule()
    
    Dim WrkSht1 As Worksheet
    Set WrkSht1 = Worksheets("Table1")
    'Worksheets("Table1").Select

    Dim Code As String
    Code = WrkSht1.Range("D1")

    Dim Wert As String
    Wert = WrkSht1.Range("E10")

    Dim WrkSht2 As Worksheet
    Set WrkSht2 = Worksheets("Table2")
    'Worksheets("Table2").Select
    'Worksheets("Table2").Range("A1").Select
      
    Dim lMaxRows As Long
    lMaxRows = WrkSht2.Cells(Rows.Count, "A").End(xlUp).Row
    WrkSht2.Cells(lMaxRows + 1, 1) = Code 'Lastrow+1 in column A.
    WrkSht2.Cells(lMaxRows + 1, 2) = Wert 'Lastrow+1 in column B.
    'Range("A" & lMaxRows).Select
    'ActiveCell.Offset(1, 0).Select
    'ActiveCell.Value = Code
    'ActiveCell.Offset(0, 1).Select
    'ActiveCell.Value = Wert
    
    WrkSht1.Rows("1:10").Delete shift:=xlUp
    'Sheets("Table1").Select                                         '
    'Rows("1:10").Select
    'Selection.Cut
    'Application.CutCopyMode = False
    'Selection.Delete Shift:=xlUp

End Sub

现在我认为你想要什么：

Sub strule1()
    
    Dim WrkSht1 As Worksheet
    Set WrkSht1 = Worksheets("Table1")
    
    Dim WrkSht2 As Worksheet
    Set WrkSht2 = Worksheets("Table2")
    
    Dim lLastRow1 As Long
    lLastRow1 = WrkSht1.Cells(Rows.Count, "A").End(xlUp).Row
    
    Dim x As Long
    Dim lLastRow2 As Long
    Dim Code As String
    Dim Wert As String
    For x = 1 To lLastRow1 Step 10
        Code = WrkSht1.Cells(x, 4)      'Loop 1 grabs from row 1, loop 2 from row 11
        Wert = WrkSht1.Cells(x + 9, 5)  'Loop 1 grabs from row 10, loop 2 from row 20
        
        lLastRow2 = WrkSht2.Cells(Rows.Count, "A").End(xlUp).Row
        WrkSht2.Cells(lLastRow2 + 1, 1) = Code 'Lastrow+1 in column A.
        WrkSht2.Cells(lLastRow2 + 1, 2) = Wert 'Lastrow+1 in column B.
    Next x

    WrkSht1.Rows("1:" & x).Delete shift:=xlUp

End Sub

循环代码直到 excel 中的单元格为空

Loop the code till the cell is empty in excel

excel

automation

vba

loops

range