Question

好的，这可能需要一些解释。我在我们工厂的机器上有一个MS Excel设置日志表，其中包含在该机器上构建的100多个不同部件号的设置规格（每行是不同的部件号）。我们正在切换到一种新格式，每个零件编号都有一个单独的工作表，每个工作表都遵循一定的格式（我事先设置了一个模板并为每个零件编号复制了它）。旧日志表的第一列包含所有部件号，表单名称对应于这些部件号。

所以我试图设置一个程序，重复每个部件号（每张表），并在旧日志表的第一列中找到该号码。然后，它将从单元格中提取值，比如该行的B列，并将该值放在该部件号的工作表中的特定单元格中。现在，这将需要从每个部件号的几个单元格中提取数据，但是如果我可以将其用于一个，我可以从那里开始。

这是我到目前为止所得到的：

Sub EditSettings()

Dim i As Integer
Dim j As Integer
Dim lastrow As Integer

lastrow = Sheets("M200 46mm Setting Log").Range("A" & Rows.Count).End(xlUp).Row

For i = 5 To Worksheets.Count

    For j = 4 To lastrow

            If Sheets("M200 46mm Setting Log").Cells(j, "A").Value = "" Then

            ElseIf Sheets("M200 46mm Setting Log").Cells(j, "A").Value = Sheets(i).Name Then

                Sheets("M200 46mm Setting Log").Range(j, "B").Copy _
                Destination:=Sheets(i).Range("D11")

            End If

    Next

Next

End Sub

但是当我运行它时，它会给我一个错误，说明＆＃34;运行时错误＆＃39; 1004＆＃39;：应用程序定义的错误或对象定义的错误＆＃34;。

Answer 1

这比你想象的要容易。您不需要遍历每个工作表，因为您可以按名称分配目标工作表：Set ws = WorkSheets([name as a string])。所以你真的只需要循环遍历行并获取每个工作表名称。

我还建议创建每个旧图纸单元格的地址映射及其新的图纸单元格地址。在您的示例中，列“B”转到“D11”，因此创建所有这些的集合并简单地循环它们以进行复制。有更快的方法可以做到这一点，但只有100个左右的不同部分，不值得担心。

以下代码显示了如何执行这两项操作。从您的问题中，您提到您已为每个新工作表创建了模板。据推测，格式设置正确，因此您无需复制/粘贴，只需将每个单元格值写入新单元格。

顺便说一句，您的代码中最明显的错误（可能是您的错误原因）是这一行：Sheets("M200 46mm Setting Log").Range(j, "B").Copy ...应为Sheets("M200 46mm Setting Log").Cells(j, "B").Copy ...

Sub RunMe()
    Dim wsLog As Worksheet
    Dim wsPart As Worksheet
    Dim sheetName As String
    Dim addressMap As Collection
    Dim map As Variant
    Dim lastRow As Long
    Dim r As Long

    Set addressMap = New Collection
    ' Map the transfer cell addresses
    addressMap.Add SetRangeMap("B", "D11")
    ' 1st item is old log sheet column, 2nd is address of new sheet
    ' ...
    ' ... repeat for all the address maps
    ' ...

    'Loop through the rows in the source sheet
    Set wsLog = ThisWorkbook.Worksheets("M200 46mm Setting Log")
    lastRow = wsLog.Cells(wsLog.Rows.Count, "A").End(xlUp).Row
    For r = 4 To lastRow
        ' Acquire the sheet name from the part number cell
        sheetName = CStr(wsLog.Cells(r, "A").Value2)
        ' Try to assign the parts number worksheet
        Set wsPart = Nothing
        On Error Resume Next
        Set wsPart = ThisWorkbook.Worksheets(sheetName)
        On Error GoTo 0
        ' If assigment worked then transfer data
        If Not wsPart Is Nothing Then
            For Each map In addressMap
                wsPart.Range(map(1)).Value = wsLog.Cells(r, map(0)).Value2
            Next
        End If
    Next
End Sub

Private Function SetRangeMap(sourceCol As String, partAddress As String) As Variant
    Dim map(1) As String
    map(0) = sourceCol
    map(1) = partAddress
    SetRangeMap = map
End Function

如何将行数据传输到变量表中的特定单元格？

1 个答案: