首页 文章

使用变量名称将行移动到工作表

提问于
浏览 次
1

我试图将工作表中的整行移动到另一个工作表，其名称将在循环时更改 . 如果temp1（主表单中的数据）等于temp2（DCM表格中的数据），那么它将创建一个具有公用名称的工作表，或者如果工作表已经存在，它将从主表单复制整行 . 工作表到新的（或已经存在的）工作表 . 这是我的代码 . 我在此行收到“下标超出范围”错误：

ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
                        Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.Count).End(xlUp).Offset(1)

Private Sub AddtoWorksheet()
Dim temp1 As String
Dim temp2 As String
Dim i As Integer
Dim x As Integer
Dim RowsUsed As Long
Dim RowsUsed2 As Long

 RowsUsed = ActiveWorkbook.Sheets("Master").UsedRange.Rows.Count
 RowsUsed2 = ActiveWorkbook.Sheets("DCM").UsedRange.Rows.Count

 For i = 2 To RowsUsed
    temp1 = ActiveWorkbook.Sheets("Master").Cells(i, 1).Value
        For x = 1 To RowsUsed2
            temp2 = ActiveWorkbook.Sheets("DCM").Cells(x, 1).Value
            If temp1 = temp2 Then
            AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
            ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
                        Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Else:
            End If
            Next x

        Next i
End Sub

Function AddSheetIfMissing(Name As String) As Worksheet

    On Error Resume Next
    Set AddSheetIfMissing = ThisWorkbook.Worksheets(Name)
    If AddSheetIfMissing Is Nothing Then
        Set AddSheetIfMissing = ThisWorkbook.Worksheets.Add
        AddSheetIfMissing.Name = Name
    End If

End Function
excel-vba variables vba excel

1 回答

  • 1

    看看这个解决方案 . 它解决了一些问题，可能会简化您的尝试，或者至少为您提供一些新的方法来解决这个问题 .

    Some notes:

    • 您应该为循环使用Long而不是Integer .

    • 如果工作表都在同一工作簿中，则不必声明“ActiveWorkbook.Sheets”

    • 您试图将变量字符串连接到目标定义中的其他内容 . '（＆temp2＆）' . 您只需要在创建字符串时这样做，但由于temp1和temp2都已经是字符串，并且是变量形式，因此您不需要这样做 . 此外，如果它们被使用，它们在该点处的值相同，因此要么在该行中起作用 .

    • 如果您不打算写一个，则不需要包含Else语句 .

    • 下面的行是指第i行，但当时DCM不在第i行，它位于第x行，您将获取错误的工作表名称 . 您刚刚将Master（i）与DCM（x）匹配，并使用了DCM（i）的值，该值位于工作表上的其他位置，未进行处理 . 此外，在那一行，因为你真的只是传递一个值，你不是要尝试传递已经具有该值的temp1 / temp2吗？

    以上参考：

    AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
    • 您可以通过列循环设置值而不是复制行，这有助于避免选择语句 . 这只是另一种方式 . 这是我复制行的首选方法，如果需要，可以让我更好地控制跳过某些值 .

    循环示例，用于将整行从一个工作表复制到另一个工作表 .

    For lCol = 1 to lastCol
    Sheets(sheet2).Cells(tRow, lCol) = Sheets(sheet1).Cells(lRow, lCol)
Next lCol

    Consider this solution:

    Private Sub AddtoWorksheet()
Dim temp1 As String, temp2 As String
Dim i As Long, x As Long, tRow As Long
Dim lastRow1 As Long, lastRow2 As Long, lastCol As Long
Dim Sheet1 As String, Sheet2 As String, tempSheet As String
Dim isNew As Boolean

'Define your sheet names
Sheet1 = "Master"
Sheet2 = "DCM"

'Get last row for each sheet
lastRow1 = Sheets(Sheet1).Range("A" & Rows.count).End(xlUp).row
lastRow2 = Sheets(Sheet2).Range("A" & Rows.count).End(xlUp).row

For i = 2 To lastRow1
    temp1 = Sheets(Sheet1).Cells(i, 1).Value
    For x = 1 To lastRow2
        temp2 = Sheets(Sheet2).Cells(x, 1).Value
        If temp1 = temp2 Then

'           AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
            isNew = AddSheetIfMissing(temp1)

            'Grab the last column number from Master sheet
            lastCol = Sheets(Sheet1).Cells(1, Columns.count).End(xlToLeft).column

            'Set the row on the new sheet
            If isNew = True Then
                tRow = 1
            Else
                tRow = Sheets(temp1).Range("A" & Rows.count).End(xlUp).row + 1
            End If

'           ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
'               Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.count).End(xlUp).Offset(1)
            For lCol = 1 To lastCol
                Sheets(temp1).Cells(tRow, lCol).Value = Sheets(Sheet1).Cells(i, lCol).Value
            Next lCol
        End If
    Next x
Next i

End Sub

    Function returning boolean test 如果工作表是新的，则为真 . 如果没有，则为假 .

    Function AddSheetIfMissing(tempName As String) As Boolean
Dim ws As Worksheet
Dim isNew As Boolean
isNew = False
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(tempName)
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add
        ws.name = tempName
        isNew = True
    End If
AddSheetIfMissing = isNew
End Function

    你所拥有的功能被设置为返回一个工作表，但在原始代码中，你没有任何实际抓取该变量，因此不需要它 . 我正在让它返回测试以查看工作表是否是新的，以帮助确定需要移动数据的行 .

    看看这个更好地解释the difference between subs and functions的链接 .
    简化的总结是它们都做事，但函数返回一个值 .

    回复于

相关问题