繁体   English   中英

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

[英]Move row to worksheet with a variable name

我试图将工作表中的整个行移动到另一个工作表,该工作表的名称将在循环中更改。 如果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

看这个解决方案。 它解决了一些问题,可能会简化您的工作,或者至少为您提供一些解决此问题的新方法。

一些注意事项:

  • 您应该使用Long而不是Integer进行循环。

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

  • 您试图连接变量字符串,而目的地定义中没有其他内容。 '(&temp2&)'。 您只需要在创建字符串时执行此操作,但是由于temp1和temp2都已经是字符串了,并且采用可变形式,因此您不需要这样做。 而且,如果正在使用它们,它们在那个点上的值是相同的,因此两者都可以在该行中工作。

  • 如果您不打算编写其他语句,则无需包含其他语句。

  • 下面的行指的是第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

考虑以下解决方案:

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

返回布尔测试的函数 ,如果工作表是New,则返回 True。 否则为假。

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

您已经设置了要返回工作表的函数,但是在原始代码中,实际上没有任何东西可以获取该变量,因此不需要它。 我正在返回测试以查看工作表是否是新的,以帮助确定需要将数据移动到的行。

查看此链接,可以更好地说明子功能之间的区别
简化的总结是,它们都做事,而函数返回一个值。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM