在vba子过程参数中传递excel表名

2 回答

• 2

  这里 . 我没有测试它 .

  Sub Test()
  
      Dim sourceTable As ListObject
      Set sourceTable = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
  
      Dim destTable As ListObject
      Set destTable = ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2")
  
      Copyandfind
  
  End Sub
  
  Sub Test2()
  
      Copyandfind ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1"), ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2")
  
  End Sub
  
  
  Sub Copyandfind(ByVal sourceTable As ListObject, ByVal destTable As ListObject)
  
      SourceTableColumnCount = sourceTable.Range.Columns.Count
      SourceTableRowCount = sourceTable.ListRows.Count
      DestRowIndex = destTable.ListRows.Count
  
  
      i = 1
      r = 0
  
      Do While r < SourceTableRowCount
  
          destTable.ListRows.Add AlwaysInsert:=True
  
              Do While i <= SourceTableColumnCount
  
                      ColumnName = sourceTable.HeaderRowRange(i).Value
                      On Error Resume Next
                      DestColumnIndex = destTable.Range.Find(ColumnName, MatchCase:= _
                      True, SearchFormat:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookAt:=xlWhole).Column
                          If Err.Number <> 0 Then
                              'In case column name in source table is not found in destination table
                          Else
                              destTable.DataBodyRange(DestRowIndex + 1, DestColumnIndex).Value = sourceTable.DataBodyRange(r + 1, i).Value
                          End If
                      i = i + 1
              Loop
  
          r = r + 1
          i = 1
          DestRowIndex = DestRowIndex + 1
      Loop
      MsgBox ("Total records saved: " & SourceTableRowCount)
  
  End Sub
  

  回复于 2024-05-05T14:02:35+08:00
• 0

  我会请求范围作为输入 . 宏将开始寻找范围的交叉和工作表中沿该宏的行的listobject .

  Sub dfg(rng1 As Range)
  Dim lo1 As ListObject, ws As Worksheet, lo As ListObject
  Set ws = rng1.Worksheet
  
  For Each lo1 In ws.ListObjects
      If Intersect(lo1.Range, rng1).Cells.Count > 0 Then Set lo = lo1
  Next
  lo.Range.AutoFilter Field:=1, Criteria1:="=", Operator:=xlAnd
  End Sub
  

  EDIT 更清晰，更简洁：

  Function DefineTable(str1 As String)
  Dim lo As ListObject
  For Each Worksheet In ActiveWorkbook.Worksheets
      For Each lo In Worksheet.ListObjects
          If lo.Name = str1 Then Set DefineTable = lo
      Next
  Next
  End Function
  Sub ert()
  Dim str1 As String, lo As ListObject
  str1 = "Táblázat1"
  Set lo = DefineTable(str1)
  lo.Range.AutoFilter Field:=1, Criteria1:="=", Operator:=xlAnd
  End Sub
  

  DefineTable将找到您的名字并吐出listobject .

  EDIT2 比以前更新鲜：

  Function DefineTable(str1 As String, Optional wb1 As Workbook)
  Dim lo As ListObject, wb As Workbook
  
  If wb1 Is Nothing Then
          Set wb = ActiveWorkbook
      Else
          Set wb = wb1
  End If
  
  For Each Worksheet In wb.Worksheets
      For Each lo In Worksheet.ListObjects
          If lo.Name = str1 Then Set DefineTable = lo
      Next
  Next
  End Function
  

  回复于 2024-05-05T14:02:35+08:00