0

我是一个完整的 excel 初学者，今天有一个作业要在明天完成。如果有人能在这方面帮助我，我将不胜感激。我有一张包含下表的表格：

在此处输入图像描述

第一个表是主表，我需要从中获取数据并使用 marco-VBA 以单独表的形式表示它。使用宏来实现这一点将不胜感激。谢谢。

假设主表有 n 列，所以我需要形成 n-1 个单独的表，其中每个表将有 2 列，第一列将始终是主表的第一列，第二列将是 (n+1)th第 n 个表的主表中的列。示例 - 第一个表将有 2 列（主表的第 1 列和主表的第 2 列），同样，第 2 表将有 2 列（主表的第 1 列和主表的第 3 列），依此类推.. ..

4

2 回答 2

4

我将在接下来的一个小时左右添加到这个答案。这个想法是让您从早期的代码块开始，而我开发后面的代码块。 编辑我现在已经完成了答案，除了您可能寻求的任何额外解释。

我同意 RBarryYoung 的观点：您没有提供足够的信息，无法让任何人为您提供完整的解决方案。此外，如果您正在尝试学习 VBA，从长远来看，为您提供解决方案将无济于事。

我通常会同意 djphatic：宏记录器对于学习匹配用户操作的 VBA 非常有用，但宏记录器不会为您提供此任务所需的大量 VBA。

我很好奇，当你显然还没有准备好这个任务时，是谁给了你这个任务。

我无法读取您的图像，因此我创建了一个名为“MasterTable”的工作表并在其中加载了数据，因此它看起来像：

样本数据

您的评论暗示此表的大小可能会发生变化，因此首要任务是确定其尺寸。有许多不同的方法来识别表格的尺寸；没有一个在任何情况下都有效。我将使用 UsedRange。

将以下内容复制到模块中：

Option Explicit
Sub SplitTable1()

  Dim UsedRng As Range

  With Worksheets("MasterTable")

   Set UsedRng = .UsedRange
   Debug.Print UsedRng.Address
   Debug.Print UsedRng.Columns.Count
   Debug.Print UsedRng.Rows.Count

  End With

End Sub

没有时间对我将向您展示的所有内容进行完整的解释，但我将尝试解释最重要的几点。

Option Explicit意味着必须声明每个变量。如果没有此语句，拼写错误的名称将自动声明一个新变量。

Debug.Print将值输出到立即窗口，该窗口应位于 VBA 编辑器屏幕的底部。如果不存在，请单击Ctrl+ G。

Dim UsedRng As Range声明一个UsedRng类型的变量Range。范围是一种对象。当你给一个对象赋值时，你必须以Set.

运行此宏将向立即窗口输出以下内容：

$A$1:$H$6
 8 
 6

我不会使用UsedRng.Address，或者UsedRng.Columns.Count但我希望您了解 UsedRange 是什么以及如何使用它。

将此宏添加到模块中：

Sub SplitTable2()

  Dim CellValue() As Variant
  Dim ColCrnt As Long
  Dim RowCrnt As Long

  With Worksheets("MasterTable")

   CellValue = .UsedRange.Value

   For RowCrnt = LBound(CellValue, 1) To UBound(CellValue, 1)
     Debug.Print "Row " & RowCrnt & ":";
     For ColCrnt = LBound(CellValue, 2) To UBound(CellValue, 2)
       Debug.Print " " & CellValue(RowCrnt, ColCrnt);
     Next
     Debug.Print
   Next

  End With

End Sub

Dim CellValue() As Variant声明一个 Variant 类型的动态数组 CellValue。 ()意味着我将在运行时声明数组的大小。

CellValue = .UsedRange.Value将数组 CellValue 设置为 UserRange 中的值。该语句根据需要设置 CellValue 的维度。

CellValue变成一个二维数组。通常，数组的第一个维度是列，第二个维度是行，但当数组从某个范围加载或加载到某个范围时，这不是 TRUE。

对于一维数组，LBound(MyArray)返回数组的下界并UBound(MyArray)返回上界。

对于二维数组，LBound(MyArray, 1)返回数组第一个维度的LBound(MyArray, 2)下界并返回第二个维度的下界。

此宏将以下内容输出到立即窗口。

Row 1: Column 1 Column 2 Column 3 Column 4 Column 5 Column 6 Column 7 Column 8
Row 2: R1C1 R1C2 R1C3 R1C4 R1C5 R1C6 R1C7 R1C8
Row 3: R2C1 R2C2 R2C3 R2C4 R2C5 R2C6 R2C7 R2C8
Row 4: R3C1 R3C2 R3C3 R3C4 R3C5 R3C6 R3C7 R3C8
Row 5: R4C1 R4C2 R4C3 R4C4 R4C5 R4C6 R4C7 R4C8
Row 6: R5C1 R5C2 R5C3 R5C4 R5C5 R5C6 R5C7 R5C8

第二个宏演示了我可以将工作表中的所有值加载到一个数组中，然后输出它们。

将此宏添加到模块中：

Sub SplitTable3()

  Dim ColourBack As Long
  Dim ColourFont As Long

  With Worksheets("MasterTable")
    ColourBack = .Range("A1").Interior.Color
    ColourFont = .Range("A1").Font.Color
    Debug.Print ColourBack
    Debug.Print ColourFont
  End With

End Sub

运行这个宏，它会输出：

 16711680 
 16777215

对于这个答案，这些只是神奇的数字。 16777215将字体颜色设置为白色，16711680并将背景或内部颜色设置为蓝色。

对于最后一个宏，我创建了另一个工作表“SplitTables”。

将此宏添加到模块中：

Sub SplitTable4()

  Dim CellValue() As Variant
  Dim ColDestCrnt As Long
  Dim ColourBack As Long
  Dim ColourFont As Long
  Dim ColSrcCrnt As Long
  Dim RowDestCrnt As Long
  Dim RowDestStart As Long
  Dim RowSrcCrnt As Long

  With Worksheets("MasterTable")
    ' Load required values from worksheet MasterTable
    CellValue = .UsedRange.Value
    With .Cells(.UsedRange.Row, .UsedRange.Column)
      ' Save the values from the top left cell of the used range.
      ' This allows for the used range being in the middle of the worksheet.
      ColourBack = .Interior.Color
      ColourFont = .Font.Color
    End With
  End With

  With Worksheets("SplitTables")

    ' Delete any existing contents of the worksheet
    .Cells.EntireRow.Delete

    ' For this macro I need different variables for the source and destination
    ' columns. I do not need different variables for the source and destination
    ' rows but I have coded the macro as though I did.  This would allow the
    ' UsedRange in worksheet "MasterTable" to be in the middle of the worksheet
    ' and would allow the destination range to be anywhere within worksheet
    ' "SpltTables".

    ' Specify the first row and column of the first sub table.  You will
    ' probably want these both to be 1 for cell A1 but I want to show that my
    ' code will work if you want to start in the middle of the worksheet.
    ColDestCrnt = 2
    RowDestStart = 3

    ' I use LBound when I do not need to because I like to be absolutely
    ' explicit about what I am doing.  An array loaded from a range will
    ' always have lower bounds of one.

    For ColSrcCrnt = LBound(CellValue, 2) + 1 To UBound(CellValue, 2)
      ' Create one sub table from every column after the first.

      'Duplicate the colours of the header row in worksheet "MasterTable"
      With .Cells(RowDestStart, ColDestCrnt)
        .Interior.Color = ColourBack
        .Font.Color = ColourFont
      End With
      With .Cells(RowDestStart, ColDestCrnt + 1)
        .Interior.Color = ColourBack
        .Font.Color = ColourFont
      End With

      RowDestCrnt = RowDestStart

      For RowSrcCrnt = LBound(CellValue, 1) To UBound(CellValue, 1)
        ' For each row in CellValue, copy the values from the first and current
        ' columns to the sub table within worksheet "SplitTables"
        .Cells(RowDestCrnt, ColDestCrnt).Value = _
                                    CellValue(RowSrcCrnt, LBound(CellValue, 2))
        .Cells(RowDestCrnt, ColDestCrnt + 1).Value = _
                                              CellValue(RowSrcCrnt, ColSrcCrnt)
        RowDestCrnt = RowDestCrnt + 1
      Next RowSrcCrnt
      ColDestCrnt = ColDestCrnt + 3     ' Advance to position of next sub table
    Next ColSrcCrnt

  End With

End Sub

这才是真正的宏。以前的所有宏都用于演示某些内容。这个宏做我认为你想要的。

带着问题回来。但是，我不知道您在哪个时区。这里是 23:00。大约一个小时后我要睡觉了。之后，明天将回答问题。

于 2012-09-16T21:07:42.593 回答
1

看看 Excel 中的宏记录器。您要实现的目标类似于使用 VBA 对表中的特定列执行简单的复制和粘贴。如果您打开宏记录器并通过复制和粘贴变量和估计列来生成第一个表，然后单击停止，您可以通过查看 Visual Basic 编辑器 (Ctrl+F11) 来查看生成的代码。

您可能会发现这些链接有些用处： http ://www.automateexcel.com/2004/08/18/excel_cut_copy_paste_from_a_macro/ http://www.techrepublic.com/blog/10things/10-ways-to-reference-excel -workbooks-and-sheets-using-vba/967

于 2012-09-16T15:41:50.253 回答