excel - 从 excel 表中填充工作表

Question

我被要求重新制作 excel 工作簿以索引我们保存项目的位置。
我有一个包含信息的表格(excel表格)的excel表格。
如果第 6 列中的值 =“10”，则表示该项目在框 10 中。
然后我需要找到正确的搁架，这可以通过第 7 列(搁架)和 8 列(机架)中的数字找到。随后，关于该项目的信息必须放在另一张表中，该表给出了盒子的视觉表示。
我正在努力获得理想的结果，有人有什么建议吗？

Sub box()
Dim rng As Range

For x = 1 To 12
Set rng = Sheets("Register").ListObject("Table1").Range(x, 8).Value

If Range("Table1").ListObject.Range(x, 6).Value = "10" Then
If Range("Table1").ListObject.Range(x, 7).Value = "1" Then
Sheets("box 10").Range(3, rng).Value = Range("Table1").ListObject.Range(x, 2).Value & Range("Table1").ListObject.Range(x, 3)

End If
End If
Next x

End Sub

Answer 1

请尝试下一个代码。它将在表中迭代 DataBodyRange并构建一个表名称，通过将“Box”与表第 6 列(在您的工作簿中)中的值串联获得。如果这样的工作表不存在，则会发送一条警告消息并停止代码:

Option Explicit

Sub box()
 Dim boxVal As String, tbl As ListObject, shBox As Worksheet, rngRef As Range, x As Long
 Dim shelvNo As Long, rackNo As Long
 Dim iRow As Long:   iRow = 1  ' row where "rack" exist
 Dim iCol As Long:    iCol = 1 'column letter where "rack" exists (C:C)

 Set tbl = Sheets("Register").ListObjects("Table1")
 For x = 1 To tbl.DataBodyRange.Rows.Count  'on the frist row there are ABC, ABC etc.
    If tbl.DataBodyRange.Cells(x, 1) = "" Then Exit For
    boxVal = tbl.DataBodyRange.Cells(x, 6).Value
    On Error Resume Next
     Set shBox = Sheets("Box " & boxVal) 'set the sheet of the appropriate box  'set the sheet of the appropriate box
     If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox "No sheet named """ & "box " & tbl.DataBodyRange.Cells(x, 6).Value & """ exists" & vbCrLf & _
                "Please, create it and run the code again!": Exit Sub
     End If
    On Error GoTo 0
    Set rngRef = shBox.Cells(iRow, iCol)
     shelvNo = iRow + 1 + tbl.DataBodyRange.Cells(x, 7).Value
     rackNo = iCol + tbl.DataBodyRange.Cells(x, 8).Value - 1
     rngRef.Offset(shelvNo, rackNo).Value = tbl.DataBodyRange.Cells(x, 2).Value & " " & tbl.DataBodyRange.Cells(x, 3).Value
 Next x
 MsgBox "Ready..."
End Sub