如何添加每个项目的23属性

我不知道如何更好地描述我的问题。 所以这是一个例子：在一个电子表格中有两个选项卡：“A”和“B”。 工作表A有一个项目列表，只有一列，但行数可能会改变。

然后表B有23行数据。 那么在这个例子中，我没有真正写出所有23行。

我想把A和B结合起来，让A中的每个项目在B中有23行属性。看起来像这样：

我怎样才能做到这一点使用macros，因为表A可以有1k +行？

Answer 1

这将完全按照你的想法：

Sub Angie() Dim i&, j&, k&, v, w, x With Sheets("a"): v = .[a1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row): End With With Sheets("b"): w = .[a1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row): End With ReDim x(1 To UBound(v) * UBound(w), 1 To 2) x(1, 1) = v(1, 1): x(1, 2) = w(1, 1) k = 1 For i = 2 To UBound(v) For j = 2 To UBound(w) k = k + 1 x(k, 1) = v(i, 1) x(k, 2) = w(j, 1) Next Next Sheets("a").[c1:d1].Resize(UBound(x)) = x End Sub 

注意：这将把结果放在表格“A”的C和D列中。 您可以通过在最后一行的方括号内进行编辑来更改输出的位置。

Answer 2

没有VBA是很容易的。 在A2的第三张表格中复制下来以适合：

  =OFFSET(A!A$2,INT((ROW()-1)/23),) 

然后将B A2：A24复制到第三张纸的B2：B24中，然后双击填充手柄。

Answer 3

这是另一种方法 – 这次使用ADO来创build输出。 这将创build一个笛卡尔积或SQL中的交叉连接。 这样做的效果是生成每个表单使用一行的每种可能的组合。

如果工作簿保存为.xlsm文件，这将工作。 如果您使用旧的.xls格式，则注释掉Excel 2007起始连接string，并删除Excel 97-2003连接string周围的注释

 Option Explicit Sub cartesian_product() ' Set up connection Dim cn As Object Set cn = CreateObject("ADODB.Connection") ' Connection string for Excel 2007 onwards .xlsm files With cn .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _ "Extended Properties=""Excel 12.0 Macro;IMEX=1"";" .Open End With ' Connection string for Excel 97-2003 .xls files ' It should also work with Excel 2007 onwards worksheets ' as long as they have less than 65536 rows 'With cn ' .Provider = "Microsoft.Jet.OLEDB.4.0" ' .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _ ' "Extended Properties=""Excel 8.0;IMEX=1"";" ' .Open 'End With ' Create and run the query Dim rs As Object Set rs = CreateObject("ADODB.Recordset") ' Cartesian product rs.Open "SELECT [Sheet1$].[Item], [Sheet2$].[Attribute] FROM [Sheet1$], [Sheet2$];", cn ' Output the field names and the results Dim fld As Object Dim i As Integer With Worksheets("Sheet3") .UsedRange.ClearContents For Each fld In rs.Fields i = i + 1 .Cells(1, i).Value = fld.Name Next fld .Cells(2, 1).CopyFromRecordset rs End With ' Tidy up rs.Close cn.Close End Sub 

Answer 4

使用VBA的解决scheme将是这样的：

 Sub adding() Dim Arr1 As Variant, Arr2 As Variant Dim runner1 As Variant, runner2 As Variant Dim i As Long Arr1 = Sheets(1).Range("A1:A25").Value Arr2 = Sheets(2).Range("A1:A25").Value i = 1 For Each runner1 In Arr1 For Each runner2 In Arr2 Sheets(3).Cells(i, 1).Value = runner1 Sheets(3).Cells(i, 2).Value = runner2 i = i + 1 Next Next End Sub 

它能做什么：

• 它循环第一个范围内的所有项目
  • 在每个循环中，循环第二个范围中的所有项目
    • 在每个循环中，它将第一个循环的实际值添加到第一列
    • 它也将第二个循环的当前值添加到第二列
    • 那么它就会计数下一行的下一个值

您仍然需要将代码更改为您想要的。
编辑：
正如评论中所写，这不是最好的办法，但是最容易的是（我的观点）。 您可能想要/需要做的所有更改：

• Sheets(1)是第一项Sheets("A")您可以将其更改为Sheets("A")或任何您想要/需要的Sheets("A")
• Sheets(2)是第二项表单（您可以将其更改为表单（“B”）或任何您想要/需要的表单
• Sheets(3)是打印出长列表的表格（您可以将其更改为表格（“C”）或任何您想要/需要的表格
• i是为行写入，有i = 1在开始有第一行作为开始四输出（你可以改变它为i = 2从第二行开始，或改变它到另一个数字，你想/需要）
• Arr1和Arr2 Range("A1:A25")设置范围以获取数据（您可以将其更改为Range("A2:A24")或任何您想要/需要的Range("A2:A24") ，也不需要相同）
• runner1和runner2 Cells(i, x) x （代码中的x为1和2）表示列表中的项目将打印在哪一列（如果您需要，可将其更改为不同的数字）
• 有3个甚至更多的列表，你只需要添加Arr3 ， Arr4 ，…和runner3 ， runner4 ，…到代码，然后包括For Each runner3 In Arr3 ， For Each runner4 In Arr4 ，…（don'忘记每个For都有一个Next ，每个Runner都有一个输出）

编辑：
只为了好玩的解决scheme没有VBA：
（为了更好的理解，我缩短了代码）

Sheet3中的单元格A2 ：

 =INDEX(Sheet1!A:A,ROUNDUP((ROW()-1)/$C$1,0)+1) 

此代码重复Sheet1每个项目x次（ Sheet1 ，…，而x是C1的值。
-1表示您没有用于输出的行。 从第二行开始离开1（ -1 ），而从第15行开始将离开14（ -14 ）
+1表示在你的源文件中跳过的行（你的源文件在第二行开始+1 ，从第九行开始将是+8 ）

Sheet3中的单元格B2 ：

 =INDEX(Sheet2!A:A,MOD(ROW()-2,$C$1)+2) 

这个代码重复了整个第二个列表（1,2,3，1，2，3，1，2，3，…）无休止的（只是你把该公式的范围）
-2和+2与第一个公式相同。 然而，每个增加1（或减less的负面部分）。 从第四行开始，对于输出结果也是-4 ，负数部分是-4 ，从第六行开始，给出+6的正数。

Sheet3中的单元格C1 ：

 =MAX(IF(ISNUMBER(MATCH({"",-1E+307},Sheet2!A:A,-1)),MATCH({"",-1E+307},Sheet2!A:A,-1)))-1 

这个代码只是searchSheet2!A:A的最后一个单元格Sheet2!A:A它不是空的，给你这个行，但是从第二行开始（第一行只是一个头），最后是-1，您的列表中的项目。 但是，如果在列表下方填充单元格，也会计算它们（包括之间的所有空单元格），以便将其更改为Sheet2!$A$2:$A$50 。 （从第一个项目开始时，您需要删除最后的-1 。）
如果你不想有一个额外的单元格，你可以简单地用这个代码replace$C$1 （没有= ，如果最后有-1 ，那么也把它放在花括号里()或者它不会按要求工作）
您还需要根据需要更改图纸名称（ Sheet1 ， Sheet2 ， Sheet3 ）和单元格范围

然后简单地自动填充，直到列A只显示“0”（B列将循环不休）
是非常dynamic的客户每一个变化将被放在你的输出。 （也有可能是这个缺点），对于非常长的列表也是如此，最好使用额外的单元格C1 （或者你想要的单元格），而不是在前两个单元格中包含第三个代码。

玩的开心 ：）