Question

我有一些代码根据列中的单元格值创建工作表，然后我有下面的代码，它将扫描同一列并将该表的整行移动到匹配的工作表名称。

Sub CopyRowData()

'Declare variables
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim shSource As Worksheet
Dim shTarget1 As Worksheet
Dim shTarget2 As Worksheet
Dim shTarget3 As Worksheet
Dim shTarget4 As Worksheet
Dim shTarget5 As Worksheet
Dim shTarget6 As Worksheet

'Assign string values to variables
Set shSource = ThisWorkbook.Sheets("1")
Set shTarget1 = ThisWorkbook.Sheets("2")
Set shTarget2 = ThisWorkbook.Sheets("3")
Set shTarget3 = ThisWorkbook.Sheets("4")
Set shTarget4 = ThisWorkbook.Sheets("5")
Set shTarget5 = ThisWorkbook.Sheets("6")
Set shTarget6 = ThisWorkbook.Sheets("7")

'Locate the rows to be checked
'2
If shTarget1.Cells(3, 6).Value = "" Then
a = 3
Else
a = shTarget1.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'3
If shTarget2.Cells(3, 6).Value = "" Then
b = 3
Else
b = shTarget2.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'4
If shTarget3.Cells(3, 6).Value = "" Then
c = 3
Else
c = shTarget3.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'5
If shTarget4.Cells(3, 6).Value = "" Then
d = 3
Else
d = shTarget4.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'6
If shTarget5.Cells(3, 6).Value = "" Then
e = 3
Else
e = shTarget5.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If

'7
If shTarget6.Cells(3, 6).Value = "" Then
f = 3
Else
f = shTarget6.Cells(3, 6).CurrentRegion.Rows.Count + 3
End If


i = 3

'Do while that will read the data of the cells in the 5th column and if it is match for the string variables, it will move the entire row to the worksheet of the same name
Do While i <= 200
    '2
    If Cells(i, 6).Value = "2" Then
    shSource.Rows(i).Copy
    shTarget1.Cells(a, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    a = a + 1
    GoTo Line1

    '3
    ElseIf Cells(i, 6).Value = "3" Then
    shSource.Rows(i).Copy
    shTarget2.Cells(b, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    b = b + 1
    GoTo Line1
    End If

    '4
    If Cells(i, 6).Value = "4" Then
    shSource.Rows(i).Copy
    shTarget3.Cells(c, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    c = c + 1
    GoTo Line1

    '5
    ElseIf Cells(i, 6).Value = "5" Then
    shSource.Rows(i).Copy
    shTarget4.Cells(d, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    d = d + 1
    GoTo Line1
    End If

    '6
    If Cells(i, 6).Value = "6" Then
    shSource.Rows(i).Copy
    shTarget5.Cells(e, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    e = e + 1
    GoTo Line1

    '7
    ElseIf Cells(i, 6).Value = "7" Then
    shSource.Rows(i).Copy
    shTarget6.Cells(f, 1).PasteSpecial Paste:=xlPasteValues
    shSource.Rows(i).Delete
    f = f + 1
    GoTo Line1
    End If

    i = i + 1


Line1:     Loop

    Set mysheet = ActiveSheet
    Dim wrksht As Worksheet
    For Each wrksht In Worksheets

    wrksht.Select
    Cells.EntireColumn.AutoFit

    Next wrksht
    mysheet.Select

End Sub

我得到＆＃34;运行时错误9，下标超出范围＆＃34;。

我收到此错误的原因是因为工作表不存在。因此，例如，当基于它们的单元格值创建纸张时，并且在单元格中没有实际的数字4，那么具有名称＆＃34; 4＆＃34;显然不会被创造出来。

理想情况下，我希望以一种不需要硬编码字符串变量来进行检查的方式对其进行编码，但我根本不知道如何创建该动态代码。所以这就是我现在所拥有的，我希望有人可以帮助清理代码，使其不具有硬编码变量（1,2,3,4 ...），如果工作表存在，可能只是先检查一下然后在列中查找工作表名称或执行相同的操作，但只需输入某种if语句，以确定工作表是否存在，然后才能进行炸弹。

我想的是：

If (sheet.name("4") exists) Then
Set shTarget4 = ThisWorkbook.Sheets("4")
Else
Resume

我不需要保留原始工作表的数据，因为这不是源表。

来自第一张纸的数据来自其来源，通过宏，所以如果我需要参考源数据，那么它不会是一个问题。

另外，另一个原因是当我的宏运行时，每张工作表将作为单独的工作簿保存在文件夹中，以便我可以将每张工作表发送到各自的部门。

Answer 1

以下是我的表现。如果Col F中的值是有效的工作表名称，则应该没问题。

db.FrequencyQuestionForm.update(
    {'data.formList.IdentificationDetails.Group_Id': 9 },
    {'$set': {'data.formList.0.IdentificationDetails.0.Group_Description': "abc"}},{ multi: true } );

Answer 2

至于你的明确问题（寻找一些If (sheet.name("4") exists) Then方式）你可以利用这个辅助函数：

Function IsSheetThere(shtName As String, sht As Worksheet) As Boolean
    On Error Resume Next
    Set sht = Worksheets(shtName)
    IsSheetThere = Not sht Is Nothing
End Function

用作：

Dim targetSht As Worksheet
If IsSheetThere("4", targetSht) Then
    ... (code to handle existing sheet)
End If

对于更一般的请求（“动态代码段”），您可以使用Range对象的AutoFilter()方法以前过滤源表单列F然后一次性将值复制/粘贴到正确的目标表单

我假设：

“1”是工作表，其第6列单元格要从第3行循环到最后一行，并将整行复制/粘贴到名称与当前单元格值匹配的目标工作表

来源表第6列在第2行有一个标题

Sub CopyRowData()
Dim sourceSht  As Worksheet
Set sourceSht = ThisWorkbook.Sheets("1")

Dim iSht As Long
Dim targetSht As Worksheet
With sourceSht
    With .Range("F2", .Cells(.Rows.Count, "F").End(xlUp))
        For iSht = 2 To 7
            If IsSheetThere(CStr(iSht), targetSht) Then
                .AutoFilter Field:=1, Criteria1:=iSht
                If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
                    Intersect(.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow, .Parent.UsedRange).Copy
                    With targetSht
                        .Cells(WorksheetFunction.Max(3, .Cells(.Rows.Count, 1).End(xlUp).Row), 1).PasteSpecial Paste:=xlPasteValues
                        .Cells.EntireColumn.AutoFit
                    End With
                    Application.CutCopyMode = False
                End If
            End If
        Next
    End With
    .AutoFilterMode = False
End With
End Sub

将数据从一张纸移动到多张纸 - vba

2 个答案: