Question

希望标题清楚。我试图在一张纸上搜索多个表格。我正在寻找的信息对于所有表都是相同的，只是相应的列位于不同的位置（例如，在一个表中，我想要搜索的列在I中，而对于另一个表，它可以在O中。）这对我来说更具挑战性。

我想搜索具有相同标题（加载编号）的每个列，并根据其值将整行复制到与该值对应的工作表上。

以下是我到目前为止在VBA中的内容以及希望澄清我的问题的图片。

感谢任何帮助/建议！

    Sub Load_Number_Finder()

Dim ws As Worksheet
Dim i As Integer
Dim j As Integer

j = 1

Set ws = Sheets.Add(After:=Sheets("Master"))
ws.Name = ("Test Load " & j)

i = 1
Sheets("Master").Select
For Each cell In Sheets("Master").Range("M:M")
If cell.Value = "1" Then
j = 1
'Set WS = Sheets.Add(After:=Sheets("Master"))
'WS.Name = ("Test Load " & j)
    matchRow = cell.Row
    Rows(matchRow & ":" & matchRow).Select
    Selection.Copy

    Sheets("Test Load " & j).Select
    ActiveSheet.Rows(i).Select
    ActiveSheet.Paste
    Sheets("Master").Select
    i = i + 1

ElseIf cell.Value = "" Then
' 2, 3, 4, 5, cases

Else
' Something needs to go here to catch when it doesnt have a load number on it yet


End If

' Err_Execute:
'    MsgBox "An error occurred."
Next

End Sub

Answer 1

试试这个功能。这应该适合你。让我知道您的工作表的结果。我做了一个模拟表并对其进行了测试，结果有效。如果这不是您正在寻找的，我可以进行更改。

Option Explicit

Sub copyPaste()
    Dim rowCount, row_ix, temp, i As Integer
    Dim TD_COL_IX As Integer
    Dim td_value As String
    Dim td_values() As String

    rowCount = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row

    For row_ix = 1 To rowCount

        temp = isNewTable(CInt(row_ix))
        If temp > 0 Then

            TD_COL_IX = temp

        ElseIf TD_COL_IX > 0 Then

            td_value = Worksheets("Master").Cells(row_ix, TD_COL_IX)
            If Not td_value = "" Then
                td_values = Split(td_value, " ")
                For i = 0 To UBound(td_values)

                    If Not sheetExists("Test Load " & td_values(i)) Then
                        Sheets.Add.Name = "Test Load " & td_values(i)
                    End If

                    If Worksheets("Test Load " & td_values(i)).Cells(1, 1).Value = "" Then
                        Worksheets("Master").Range(Worksheets("Master").Cells(row_ix, 1), Worksheets("Master").Cells(row_ix, TD_COL_IX - 1)).Copy _
                            Destination:=Worksheets("Test Load " & td_values(i)).Cells(1, 1)
                    Else
                        Dim rowCount_pasteSheet As Integer
                        rowCount_pasteSheet = Worksheets("Test Load " & td_values(i)).Cells(Rows.Count, "A").End(xlUp).Row

                        Worksheets("Master").Range(Worksheets("Master").Cells(row_ix, 1), Worksheets("Master").Cells(row_ix, TD_COL_IX - 1)).Copy _
                            Destination:=Worksheets("Test Load " & td_values(i)).Cells(rowCount_pasteSheet + 1, 1)
                    End If
                Next i
            End If
        End If
    Next row_ix
End Sub


Function isNewTable(row_ix As Integer) As Integer
    Dim colCount, col_ix As Integer

    colCount = Worksheets("Master").Cells(row_ix, Columns.Count).End(xlToLeft).Column
    For col_ix = 1 To colCount

        If Not IsError(Worksheets("Master").Cells(row_ix, col_ix).Value) Then
            If Worksheets("Master").Cells(row_ix, col_ix).Value = "LD #" Then
                isNewTable = col_ix
                Exit Function
            End If
        End If
    Next col_ix

    isNewTable = 0
End Function



' ####################################################
' sheetExists(sheetToFind As String) As Boolean
'
' Returns true if the sheet exists, False otherwise
' ####################################################
Public Function sheetExists(sheetToFind As String) As Boolean
    Dim sheet As Worksheet
    sheetExists = False
    For Each sheet In Worksheets
        If sheetToFind = sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next sheet
End Function

使用不同位置的列搜索同一工作表上的多个表，并将其复制到另一个工作表

1 个答案: