Question

我有两张带有动态表格的表格，这些表格是通过从数据库导出生成的两张单独的表格。

我想循环这两个表并执行一些操作但是因为我是初学者，所以我有点挣扎。要执行的操作如下：

表1：在表1的第1列上循环，并将变量中的单元格值保存为字符串

在这个循环中转到表2：循环遍历表2的第1列和

IF（表2第1列的单元格值=表1第1列的单元格值）

（转到表2的第4列，只有在此新表中尚未粘贴该值时，才将该值复制粘贴到新表中的新表中）

退出循环2

退出循环1

最后我应该有x张新表，具体取决于表1中包含的行数。

我使用以下代码编辑了我的帖子：

Dim rowValue As String
Dim rowValue2 As String
Dim row2 As Integer
Dim row As Integer

LastRowCopy = ActiveSheet.UsedRange.Rows.Count
LastRowPaste = ActiveSheet.UsedRange.Rows.Count

Sheets("TestPerimeter")
Range("A1").Select
For row = 2 To LastRow

    Sheets("TestData")
    For row2 = 1 To LastRow2
        If Cells(row2, 1) = Cells(row, 1) Then
        With ThisWorkbook
            .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Cells(row2,4).Value
        End With    
        End If
    Next row2

Next row

但我知道，代码写得不好。

我希望我的问题很清楚。

谢谢

Answer 1

我认为这段代码会对你有所帮助......我添加了一些评论来指导你。使用您的表名对其进行调整，尝试并尝试了解发生的事情。您的代码中存在一些逻辑错误......

Option Explicit

Sub test()
    Dim wOne As Worksheet
    Dim wTwo As Worksheet
    Dim wTarget As Worksheet
    Dim lastRowTOne As Long
    Dim lastRowTTwo As Long
    Dim i As Long
    Dim j As Long
    Dim matchCheck As String
    Dim y As Long

    'Save a reference to the two Table Objects
    Set wOne = Worksheets("Table1") 'Your Tablename ("TestPerimeter"?) instead of "Table1"
    Set wTwo = Worksheets("Table2") 'Your Tablename ("TestData"?) instead of "Table2"


    'Getting the last rows for each table
    lastRowTOne = wOne.UsedRange.Rows.Count
    lastRowTTwo = wTwo.UsedRange.Rows.Count

    'Pointer for the row in the new target sheet
    y = 1

    For i = 2 To lastRowTOne
        matchCheck = wOne.Cells(i, 1).Value
        For j = 1 To lastRowTTwo
            If wTwo.Cells(j, 1).Value = matchCheck Then
                'If there is a first match, create a new sheet
                If y = 1 Then
                    Set wTarget = Worksheets.Add
                End If
                'add the matching string
                wTarget.Cells(y, 1).Value = matchCheck
                'increase the pointers value
                y = y + 1
                'here you found a match... so exit this loop
                Exit For
            End If
        Next j
    Next i
End Sub

Answer 2

我对你的脚本进行了一些修改，现在我有了这个：

Sub test()
Dim wOne As Worksheet
Dim wTwo As Worksheet
Dim wTarget As Worksheet
Dim lastRowTOne As Long
Dim lastRowTTwo As Long
Dim i As Long
Dim j As Long
Dim matchCheck As String
Dim y As Long

'Save a reference to the two Table Objects
Set wOne = Worksheets("t_test_perimeter") '<- compilation error here when I do a mouse over on the error I have: Worksheets("t_test_perimeter") = <Subscript out of range>
Set wTwo = Worksheets("t_test_data")


'Getting the last rows for each table
lastRowTOne = wOne.UsedRange.Rows.Count
lastRowTTwo = wTwo.UsedRange.Rows.Count


For i = 2 To lastRowTOne
    'Pointer for the row in the new target sheet
    y = 1
    matchCheck = Right(wOne.Cells(i, 1).Value, Len(wOne.Cells(i, 1).Value) - 4)
    For j = 2 To lastRowTTwo
        If wTwo.Cells(j, 1).Value = matchCheck Then
            'If there is a first match, create a new sheet
            If y = 1 Then
                Set wTarget = Worksheets.Add
            End If
            'add the matching string
            wTarget.Cells(y, 1).Value = wTwo.Cells(j, 9)
            'increase the pointers value
            y = y + 1
        End If
    Next j
Next i
End Sub

有人可以告诉我有关错误的信息吗？在我的excel文件中单击表格的单元格然后执行CTRL + A：我在公式栏旁边的左上角字段中获取了表名。在VBA代码中使用此表名是不正确的？

非常感谢。我找到了一个解决方案，不选择表格而只选择工作表，现在效果很好。

VBA - 执行操作的两个循环

2 个答案: