삭제하고 셀 Excel에서 테이블

Question

에 있으면 나는 a를가 시트 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에 추가되어야하는지 여부를 판별하고 그렇지 않은 경우 행을 삭제해야합니다.

B, D & E 원래 데이터로부터 남은 유일한 행과 해당 행 아래에 추가 행수 있다고 시트 이하에서 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는 각 나머지 행에 대해 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