Question

在Excel中，我在Sheet 1中设置了以下内容

  A   B     C     D     E
1 a   12    123     
2 b   234   2342        
3 c   12    23    54    342
4 d   234   33    54    
5 e   234   34    66    
6 f   345

和表2中的表格

  A B
1 b 2
2 d 3
3 e 1

工作表2确定是否应将某些额外行添加到工作表1中，如果不是，则应删除该行。

在表1中给出结果

   A    B     C     D
 1 b    234   2342  
 2          
 3          
 4 d    234   33    54
 5
 6
 7          
 8 e    234   34    66
 9

请注意b，d＆amp; e是原始数据中剩余的唯一行，并且该行下面添加的行数与工作表2中每列剩余行的数字相关。

我想用VBA来实现它。我已经读过根据条件删除行意味着你需要经历从底行到顶行的循环，但我很难让它适用于我的例子。

这是我到目前为止使用的代码，但它似乎无法工作：

Sub maketab()


Range("A1").Select
Dim r As Long
lr = Range("A1").Row
hr = Range("A1").Offset(8 - 1).Row

For r = hr To lr Step -1

    Dim given_rng As Range

    Set given_rng = Sheet2.Range("A1")
    Dim p As Long
    lr_small = given_rng.Row
    hr_small = given_rng.End(xlDown).Row

    For p = hr_small To lr_small Step -1
            If Range("A" & r).Value = Range("A" & p).Value Then
                'Add a row below
                Range("A" & r).Offset(1).Select
                Selection.Resize(Sheet2.Range("A" & p).Offset(0, 1).Value).EntireRow.Insert
                Range("A" & r).Select
            Else
                'Delete a row
                Rows(r & ":" & r).Select
                Selection.Delete Shift:=xlUp
            End If
    Next p
Next r

End Sub

一如既往，我们将非常感谢任何帮助

Answer 1

试试这个：

Sub test()
Dim xlws1 As Worksheet
Dim xlws2 As Worksheet
Dim xlws3 As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer

'setting sheet variables
Set xlws1 = Worksheets("Sheet1")
Set xlws2 = Worksheets("Sheet2")
Set xlws3 = Worksheets("Sheet3")

k = 1 'setting initial value of k
i = 1 'setting initial value of i
Do While IsEmpty(xlws1.Range("A" & i)) = False
    j = 1 'resetting j

    Do While IsEmpty(xlws2.Range("A" & j)) = False 'setting loop up

        If xlws1.Range("A" & i).Value = xlws2.Range("A" & j).Value Then 'if value matches current sheet 1 value

            xlws1.Rows(i).Copy ' copy row
            xlws3.Range("A" & k).PasteSpecial xlPasteAll 'paste row
            k = k + 1 'increment k
            Exit Do ' move on
        End If

    j = j + 1 'increment j
    Loop

    i = i + 1 'increment i
Loop


End Sub

如何根据单元格是否在表中删除和添加行

1 个答案: