Vba 在一张工作表上构建表格，其中包含来自多张工作表的数据和不同的列长度

我需要在一张纸上构建一个表，每次从15张纸中提取1个数据。这些纸是按日期分开的。日期在一个单元格中。其他数据名称、班次、站点、产品、包装、容量和性能在我们跨越日期时，可以在不同的表之间具有不同的列长度。在构建表时，我希望记录每一行上的日期，这些日期与从表中获取的数据相匹配。 我从下面的代码开始，尝试选择每个数据列的第一个数据单元，并希望向下移动该列，直到有一个空白单元，然后选择该部分以将其传输到表中。 这将是一个很长的代码，我希望一次只做一件事，随着它的发展，我会问更多的问题。这是我的第一个问题-如何调整代码，通过选择数据来选择列以获取信息，直到到达空白单元格

谢谢

Sub DataTable()
Dim rcell1, rcell2, rcell3, rcell4, rcell5, recell6, rcell7, rcell8 As Long

    Worksheets("1").Activate
    Range("G4").Select
    rcell1 = Selection.Value ' Date

    Range("B9").Select
    Selection.End(xlDown).Select ' Name 
    rcell2 = Selection.Value 

    Range("C9").Select
    Selection.End(xlDown).Select ' Shift 
    rcell3 = Selection.Value 

    Range("D9").Select
    Selection.End(xlDown).Select ' Station
    rcell4 = Selection.Value 

    Range("E9").Select
    Selection.End(xlDown).Select ' Product
    rcell5 = Selection.Value 

    Range("F9").Select
    Selection.End(xlDown).Select ' Package
    rcell6 = Selection.Value 

    Range("O9").Select
    Selection.End(xlDown).Select ' Capacity 
    rcell7 = Selection.Value 

    Range("Q9").Select
    Selection.End(xlDown).Select ' Performance
    rcell8 = Selection.Value 

    End Sub

---

您不需要定义每个单独的列。您应该使用UsedRange来选择包含数据的所有列/行，并将值分配给2D数组，然后可以使用循环操作该数组。

此代码应该为您提供良好的开端，并在每个工作表中循环注意案例如何检查工作表的名称。您还需要更新我可能假设的任何范围引用

Sub DataTable()


Dim wsTable As Worksheet
Set wsTable = Worksheets("Table") 'change as needed

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    Select Case ws.Name

        Case Is = "1", "2", "3", "4", "5" ' etc.

            With ws

                Dim rngData As Range
                Set rngData = Union(.Range("B:F"), .Range("O:O"), .Range("Q:Q"))

                Dim lRow As Long
                Dim rCheck As Range
                For Each rCheck In Intersect(rngData, .Rows(1))

                    If .Cells(.Rows.Count, rCheck.Column).End(xlUp).Row > lRow Then
                         lRow = .Cells(.Rows.Count, rCheck.Column).End(xlUp).Row
                     End If

                Next


                Dim dDate As Date
                dDate = .Range("G4").Value

                With wsTable

                    .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(lRow, 1).Value = dDate
                    ws.Range("B9:F" & lRow).Copy 
                   .Range("B" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                    ws.Range("O9:O" & lRow).Copy 
                    .Range("O" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                    ws.Range("Q9:O" & lRow).Copy 
                    .Range("Q" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

                End With

            End With

    End Select

Next

End Sub

---

fwiw，我发现矩形数据块比。是的，这可能行得通，但是如果一列或一行中有一个空格，后面有更多的数据，会发生什么？UsedRange捕获所有内容。要使CurrentRegion丢失数据，整行或整列必须为空。CurrentRegion在数据的“孤岛”上工作，这些孤岛向各个方向延伸，直到满足一个完整的空白行或空白列。通过选择单元格并点击[Ctrl]+a一次，可以在工作表上手动演示该方法。对于矩形孤岛数据，通常会有列标题标签，带有“完全空白列”，完全空白行通常表示数据不正确，这不是正常情况。感谢您在此处的输入。CurrentRegion很有用。感谢您的帮助。我调整了代码，但无法使其完全运行。我在VBA中复制了下面的代码。我收到一个错误：对象“\u工作表”的方法“Range”失败。这发生在以下行：Set rngData=Union.RangeB:F、.RangeO、.RangeQ。我唯一更改的点是设置wsTable=WorksheetsEfficiency'根据需要更改，大小写为=1、2、3、4、5、6、7、8、9、10、11、12、13、14、15。我假设大小写是工作表名称。@kish-请参阅我在该行所做的编辑。对语法错误表示歉意。斯科特：这是可行的，但有三个问题。1.将日期传输到表中时，列中的第一个日期单元格将覆盖列标题。2.日期和与其匹配的数据之间不匹配，数据列的长度可能不一致，因为它从一天到另一天的工作表。我需要日期行的数量与每天可用的数据行的数量相同；三,；日常工作表中表格的单元格颜色和边框格式显示在最终表格中。我只想查看数据。@Kish-请查看With wsTable块中我对点1和3的编辑。对于第2点，此行中的lRow变量.RangeA&.Rows.Count.EndxlUp.Offset1.ResizelRow，1.值应将日期填充到每个工作表中找到的精确行数。可能是因为代码的编写方式是在向下移动一个单元格的过程中重写列标题，这也会导致日期行丢失，因为在每个日期，它都会覆盖上一个日期的最后一个单元格。我为第1点所做的修复也可以解决这个问题。但是如果没有，你可以很容易地根据数据进行调试。我们已经取得了进展，但是还有一些错误。在lRow=rngData.Find*、SearchOrder:=xlByRows、SearchDirection:=xlPrevious.Row行中，代码正在这些单元格中查找任何内容。它也在提取单元格格式，这是一个颜色编码的表。我只想搜索数据或文本。接下来，我们从中提取数据的表格格式从第9单元上升到第20单元。在我们正在构建的表上，我注意到日期填充了标题行后的20行。。。