테이블에 새 행과 데이터를 추가하는 함수 또는 하위

테이블에 새 행과 데이터를 추가하는 함수 또는 하위

저는 기본적으로 특정 이름의 엑셀 테이블을 공략할 수 있는 Sub를 만들고 그 아래에 새로운 행을 삽입하고 그 행에 데이터를 동시에 추가하고 싶습니다.그런 다음 서브를 종료합니다.그리고 테이블에 데이터가 없는 행이 하나만 있는 경우 해당 행에 데이터를 추가한 다음 서브를 종료합니다.

이거 어떻게 해요?

나는 의사코드로 이런 생각을 하고 있었습니다.

Public Sub addDataToTable(ByVal strTableName as string, ByVal strData as string, ByVal col as integer)

ActiveSheet.Table(strTableName).Select
If strTableName.Rows.Count = 1 Then
    strTableName(row, col).Value = strData
Else
    strTable(lastRow, col).Value = strData
End if

End Sub

이것은 아마도 코드로서 전혀 유효하지 않지만, 적어도 내가 무엇을 추구하는지 설명해 줄 것입니다!

저는 이와 같은 솔루션이 필요했지만, 네이티브 메소드를 사용할 경우 테이블 바로 아래에 있는 모든 데이터와 충돌할 위험을 피할 수 있습니다.아래 루틴에서는 테이블의 마지막 행을 확인하고 비어 있으면 해당 행에 데이터를 추가합니다. 그렇지 않으면 테이블 끝에 새 행을 추가합니다.

Sub AddDataRow(tableName As String, values() As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = ActiveWorkbook.Worksheets("Sheet1")
    Set table = sheet.ListObjects.Item(tableName)

    'First check if the last row is empty; if not, add a row
    If table.ListRows.Count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.Count).Range
        For col = 1 To lastRow.Columns.Count
            If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then
                table.ListRows.Add
                Exit For
            End If
        Next col
    Else
        table.ListRows.Add
    End If

    'Iterate through the last row and populate it with the entries from values()
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(values) + 1 Then lastRow.Cells(1, col) = values(col - 1)
    Next col
End Sub

함수를 호출하려면 테이블의 이름과 열당 하나의 값으로 구성된 값 배열을 전달합니다.테이블의 이름을 가져오거나 설정할 수 있습니다.DesignExcel 2013에서 리본 탭은 다음과 같습니다.

열이 세 개인 표의 코드 예제:

Dim x(2)
x(0) = 1
x(1) = "apple"
x(2) = 2
AddDataRow "Table1", x

이것이 당신이 찾고 있던 것이에요?

Option Explicit

Public Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal col As Integer)
    Dim lLastRow As Long
    Dim iHeader As Integer

    With ActiveSheet.ListObjects(strTableName)
        'find the last row of the list
        lLastRow = ActiveSheet.ListObjects(strTableName).ListRows.Count
        'shift from an extra row if list has header
        If .Sort.Header = xlYes Then
            iHeader = 1
        Else
            iHeader = 0
        End If
    End With
    'add the data a row after the end of the list
    ActiveSheet.Cells(lLastRow + 1 + iHeader, col).Value = strData
End Sub

헤더가 있든 없든 두 경우 모두 처리합니다.

이미 Geoff의 답변을 변형한 Philfri의 답변의 사소한 변형: 배열 코드에 대한 데이터가 포함되지 않은 완전히 비어 있는 테이블을 처리할 수 있는 기능을 추가했습니다.

Sub AddDataRow(tableName As String, NewData As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    'First check if the last row is empty; if not, add a row
    If table.ListRows.Count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.Count).Range
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Iterate through the last row and populate it with the entries from values()
    If table.ListRows.Count = 0 Then 'If table is totally empty, set lastRow as first entry
        table.ListRows.Add Position:=1
        Set lastRow = table.ListRows(1).Range
    Else
        Set lastRow = table.ListRows(table.ListRows.Count).Range
    End If
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1)
    Next col
End Sub

제프의 답변에 약간의 변화가 있습니다.

배열된 새 데이터:

Sub AddDataRow(tableName As String, NewData As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    'First check if the last row is empty; if not, add a row
    If table.ListRows.Count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.Count).Range
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Iterate through the last row and populate it with the entries from values()
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1)
    Next col
End Sub

수평 범위의 새 데이터:

Sub AddDataRow(tableName As String, NewData As Range)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    'First check if the last table row is empty; if not, add a row
    If table.ListRows.Count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.Count).Range
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Copy NewData to new table record
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    lastRow.Value = NewData.Value
End Sub

이게 도움이 될 겁니다

Dim Ws As Worksheet
Set Ws = Sheets("Sheet-Name")
Dim tbl As ListObject
Set tbl = Ws.ListObjects("Table-Name")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

With newrow

        .Range(1, Ws.Range("Table-Name[Table-Column-Name]").Column) = "Your Data"

End With

명명된 테이블이 없는 작업 솔루션

가정

• 재빠르고 더러운

• src 및 destination - destination - 각 테이블이 하나씩 있는 시트

• 한 시트에서 다른 시트로 데이터 복사

• 고정된 정적 행dest_last_row동적이 아닌 헤더의 경우.

  Sub copy()
  
    With thisworkbook.sheets(1)
    src_last_row = .Range("a" & .Rows.Count).End(xlUp).Row
  
    Set src_rng = .Range(.Cells(2, .columns("a").column), .Cells(src_last_row, 
    .Range("b" & 1).Column))
    End With
  
    With thisworkbook.Sheets(2)
      dest_last_row = .Range("a" & .Rows.Count).End(xlUp).Row
      if dest_last_row =3 then
        dest_last_row=2 
      end if
  
      Set dest_rng = .Range(.Cells(dest_last_row + 1, 1), .Cells(src_last_row + dest_last_row+1, .Range("b" & 1).Column))
  
      src_rng.Copy dest_rng
    End With
  
  End Sub
  

명명된 표의 다른 답변에 대한 단점

• 에서 사용되는 고정된 정적 행이 필요합니다.dest_last_row...
• 직관력이 떨어지는

장점

• 하나의 행이 아닌 여러 행(실제 범위) 복사
• 명명된 테이블 방식을 배울 필요가 없습니다.

언급URL : https://stackoverflow.com/questions/8295276/function-or-sub-to-add-new-row-and-data-to-table