Question

我有一个excel VBA子过程，我想将工作簿中的excel表的名称传递给该子的参数。

例如：

Sub Copyandfind()

SourceTableColumnCount = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").Range.Columns.Count
SourceTableRowCount = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").ListRows.Count
DestRowIndex = ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2").ListRows.Count


i = 1
r = 0

Do While r < SourceTableRowCount

    ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2").ListRows.Add AlwaysInsert:=True

        Do While i <= SourceTableColumnCount

                ColumnName = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").HeaderRowRange(i).Value
                On Error Resume Next
                DestColumnIndex = ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2").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
                        ThisWorkbook.Worksheets("Sheet2").ListObjects("Table2").DataBodyRange(DestRowIndex + 1, _
                        DestColumnIndex).Value = _
                        ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").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

我需要替换所有要作为参数传递的table1和table2，以便通过传递表名来将此过程用于不同的表。

谢谢..

Answer 1

下面。我没有测试它。

Dim rw As Long
Dim lr As Long
Dim cnt As Long
lr = 500
rw = 2
cnt = 1
last_prefix = ""
Do
    this_prefix = left(Range("A" & cnt).Value, 4)
    If this_prefix <> last_prefix
        Rows(rw).Insert Shift:=xlDown
        cnt = cnt + 1
    Else
        cnt = cnt + 1
    End If
    last_prefix = this_prefix
    rw = rw + 1
Loop While rw <> lr

Answer 2

我会请求范围作为输入。宏将开始寻找范围的交叉点和工作表中沿该宏的行的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

修改更清晰，更简洁：

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

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

2 个答案: