我正在尝试将工作表中的整行移动到另一个工作表,该工作表的名称将在循环播放时更改。如果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
答案 0 :(得分:1)
看看这个解决方案。它解决了一些问题,可能会简化您的尝试,或至少为您提供一些新的方法来解决这个问题。
有些说明:
您应该为循环使用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
考虑这个解决方案:
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
返回布尔测试的函数,如果工作表是新的,则返回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
你所拥有的功能被设置为返回一个工作表,但在原始代码中,你实际上并没有抓住那个变量,因此不需要它。我让它返回一个测试,以查看工作表是否是新的,以帮助确定需要移动数据的行。
查看此链接,更好地解释the difference between subs and functions 简单的总结是它们都做了事情,但函数返回了一个值。