큰 통합 문서에 코드를 구현하고 Loop Through를 통해 펑키 한 작업을 수행합니다. Excel VBA

Question

먼저 vba를 처음 사용하고 이러한 매크로를 작성하는 데 도움을 받으므로 저와 함께하시기 바랍니다.

두 개의 매크로가 있습니다. 첫 번째 테이블은 이론적으로 테이블이 가득 차면 추가 데이터를 입력 할 수 있고 이론적으로 두 번째 매크로는 테이블을 삭제할 예정입니다 데이터가 외부에서 제거 될 때 추가 행이 생기므로 테이블이 빈 행으로 너무 크게 커지지 않습니다.

통합 문서에는 32 매가 있습니다. 이러한 시트 중 26 개는 사용자와 상호 작용하며, 26 개 중 각 시트는 총 78 개의 테이블에 대해 3 개의 테이블을가집니다.

는 먼저 매크로

:
그것이 어떻게해야 무슨 : 새 행 (총 행 제외) 사용자가 특정 시트에 3 표 1에 데이터를 입력 할 때 그들은 마지막 행에 금액을 입력하다 계속해서 데이터를 입력 할 수있게하고 공식이 채워지는 것처럼 보입니다.

실제로 수행중인 작업 : 테이블의 아무 곳이나 클릭 할 때마다 자동으로 두 개의 새 행이 추가되고 데이터가 채워지지 않으므로 테이블의 가운데에 행이 추가되고 각 행에 대해이 작업이 수행됩니다 그 표에있는 표.

두 번째 매크로 : 수행 할 작업 : 모듈에 있고 저장시 설정했습니다. 통합 문서의 각 테이블을 반복하여 데이터가없는 행을 삭제합니다. ThisWorkbook의 전화 번호이지만 저장 중에는 작동하지 않습니다.

먼저 매크로 여기

Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range) 

'Declaration of Variables 
Dim LastRow As Long 
Dim tbl As ListObject 

For Each tbl In Sht.ListObjects 

'Set Lastrow 
LastRow = tbl.Range.Rows.Count 
LastRow = LastRow + tbl.HeaderRowRange.Row - 1 

'Check - is someone entering in account name for the last open row 
If Sht.Range("B" & LastRow - 1) = "" Then 'User is not entering in account name in last open row 
'do nothing 
Else 'User is entering in account name in last open row - create new row 
Application.EnableEvents = False 'turn off event handlers which allows sub to execute 
'UNPROTECT SHEET CODE HERE 
tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count).Insert 
Intersect(Sht.Range("B:L"), tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count)).Insert 
'PROTECT SHEET CODE HERE 
Application.EnableEvents = True 'turn on event handlers 
End If 

Next tbl 

End Sub 

이 당신이 원하는 일을해야 각 워크 시트의 측면을 정렬 테이블의 단일 열이 가정하면 두 번째 매크로

Sub Delete_Table_Rows() 

Dim tbl As ListObject 
Dim i As Long 
Dim rowCount As Long 
Dim ws As Worksheet 

Application.ScreenUpdating = False 

For Each ws In ThisWorkbook.Worksheets 
For Each tbl In ws.ListObjects 

'How many rows in the table? 
rowCount = tbl.DataBodyRange.Rows.Count 

'Error checking 
If rowCount < 3 Then 
'Not enough rows in table to do anything 
Exit Sub 
End If 

'Since we're deleting rows, we'll loop backwards 
For i = rowCount - 2 To 1 Step -1 
'Using Client column as reference point, it goes row by row 
'And Resizes to be 4 cells wide when it looks for blank cells 
If WorksheetFunction.CountA(tbl.ListColumns(1).DataBodyRange.Cells(i).Resize(1, 4)) = 0 Then 
    'UNPROTECT SHEET CODE HERE 
    tbl.DataBodyRange.Rows(i).Delete 
    'PROTECT SHEET CODE HERE 
End If 
Next i 

Next tbl 
Next ws 

Application.ScreenUpdating = True 

End Sub 

Answer 1

입니다. 테이블의 열 'B'의 마지막 행이 비어 있지 않으면 테이블에 새 행이 삽입됩니다. 여러 테이블을 서로 위에 쌓아 놓고 여러 열을 사용하는 경우이 방법이 효과적입니다. 테이블 사이에 적어도 하나 이상의 빈 행이 있어야합니다. 이것이 작동하는 방식은 테이블 아래에있는 테이블 (즉, 'B'열의 셀 2 개가 테이블에 있음)을 감지하고이 빈 행을 차지하도록 테이블을 확장하려고하면 빈 행을 삽입하여 테이블 간의 하나의 행 버퍼가 유지됩니다. 그래서 첫 번째 매크로 내 업데이트는 이것이다 :

Public Function IsCellInTable(rng As Range) As Boolean 
    IsCellInTable = Not rng.ListObject Is Nothing 
End Function 


Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range) 

    Dim LastRow As Long 
    Dim tbl As ListObject 

    For Each tbl In Sht.ListObjects 

    LastRow = tbl.ListRows(tbl.ListRows.Count).Range.Row 

    If Sht.Range("B" & LastRow) <> "" Then 
    Application.enableEvents = False 
     If IsCellInTable(Rows(LastRow + 2).Cells(1, 2)) Then 
     Rows(LastRow + 1).EntireRow.Insert 
     End If 
     tbl.ListRows.Add alwaysinsert:=False 
    Application.enableEvents = True 
    End If 

    Next tbl 

End Sub 

방금 ​​전에 같이 당신이 'Workbook_BeforeSave'에 전화를해야 저장에 'Delete_Table_Rows'서브 루틴을 트리거하기 위해서 :

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Delete_Table_Rows 
End Sub 

주 워크 시트의 테이블에 다른 열이있는 경우 삭제 루틴이 작동하지 않습니다. 이것에

tbl.DataBodyRange.Rows(i).Delete 

:

tbl.DataBodyRange.Rows(i).EntireRow.Delete 

이 행을 변경해야합니다 그것은 후자의 경우에 작동하게하려면