如何刪除和添加基於行如果單元格是表

在Excel我在表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 & E組從原始數據剩餘的唯一的行，也即行下方添加的行數涉及在列中的數字B在表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

一如往常的任何幫助，將不勝感激

來源

2014-11-05 h.l.m

Hi @hlm您的代碼缺少'p = hr_small至lr_small Step -1'循環中的'If'語句。我得到一個'結束如果沒有塊如果'錯誤。 – Socii 2014-11-05 09:55:11

oups我刪除了EndIf這是我之前想要添加的一個條件，但是決定將其刪除爲問題中的最小示例。現在編輯這個問題來處理這個問題... – 2014-11-05 10:02:37

@ h.l.m sheet 2 colA用於匹配表單1和表單2 colB用於向表單1添加行？ – ZAT 2014-11-05 10:06:57

試試這個：

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

來源

2014-11-05 21:24:41 Tbaker

如何刪除和添加基於行如果單元格是表

回答

相關問題