如何添加的每個項目23屬性

Question

我不知道該怎麼形容我的問題更好。所以這裏有一個例子： 我有一個電子表格兩個標籤：「A」和「B」。表A有項目列表，只有一列，但行會改變的數量。

然後表B具有23行數據。那麼在這個例子中，我沒有真正寫出所有23行。

我想結合A和B已在每個項目有23行中B.屬性如下：

我怎樣才能做到這一點使用一個宏，因爲表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 

注：這將放置在列C和片 「A」 的d的結果。您可以通過在最後一行的方括號內進行編輯來更改輸出的位置。

Answer 2

用VBA的解決辦法是這樣的：

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 

做些什麼：

• 它循環的第一範圍
  在每個循環
  • 的所有項目，它遍歷所有在第二範圍
    • 項中的每個環將其添加S中的第一環的第一列的實際值
    • 它也增加了第二循環的當前值，第二列
    • 然後計數i下一行中inseet的下一個值

您仍然需要更改代碼以符合您的需要。
編輯：
因爲它是寫在評論，這不是最好的方式做到這一點，但最簡單的unterstand（在我看來）。所有你可能需要/更改需要做：

• Sheets(1)是片材的第一項（你可以將其更改爲Sheets("A")或任何你想/需要
• Sheets(2)是該板與第二項（您可以將其更改爲表格（「B」）或任何您想要/需要的東西
• Sheets(3)是打印出長列表的表格（您可以將其更改爲表格（「C」）或任何您想要的表格/需要
• i是爲行寫入，有i = 1在開始有冷杉牛逼行作爲開始 Four的輸出（你可以將其更改爲i = 2開始在第二排，或將其更改爲你想要另一個數/需）
• Range("A1:A25")爲Arr1和Arr2設置範圍從獲取數據（您可以將它們更改爲Range("A2:A24")或您想要/需要的任何內容。他們也不必相同）
• 的x在Cells(i, x)（x是在代碼runner1 1和2）和runner2告訴在此列中選擇您列出的項目將被打印（將其更改爲不同如果你想/需要）
• 具有3名甚至更多的列表，你可以簡單地添加數Arr3，Arr4，......和runner3，runner4，...的代碼，然後包括For Each runner3 In Arr3，For Each runner4 In Arr4，... （不要忘了每0123,有一個Next和每個runner的輸出）

編輯：
只是換有趣的解決方案，而VBA：
（我縮短了更好的理解代碼）在工作表Sheet 3

細胞A2：

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

此代碼重複每個項目從Sheet1 x次（1,1,1,2,2,2,3,3,3，...，而x是C1的值。
-1指示您沒有用於輸出的行。從第二行開始離開1（-1），同時從第15行開始將離開14（-14）
+1指示要在源處跳過的行（讓源從第二行開始，結果爲+1，從第九行是+8）

細胞B2在工作表Sheet：

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

此代碼重複整個第二列表（1，2，3，1，2，3，1，2，3，。 ..）無限地（只是你把該公式的範圍）
-2和+2與第一個公式中的相同。然而，每一個增加1（或負值減少）。從第四行開始輸出也是-4的負數部分，並且從第六行開始您的數據源會爲您提供+6正數。

細胞C1在工作表Sheet 3：

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

此代碼只是在Sheet2!A:A這是不是空的，給你行，但與第二行開始搜索的最後一個單元格（第1行僅僅是一個標題）最後有-1表示列表中的項目。然而，具有低於列表填充細胞會指望他們還（包括之間的所有空單元格），所以你可以將其更改爲Sheet2!$A$2:$A$50。 （從第一項開始時，您需要在最後刪除-1。）
如果您不想爲此添加額外的單元格，則可以簡單地用此代碼替換$C$1（不含=，也可以將其替換爲在爲A2代碼括號()如果在-1在年底或將無法正常工作所需）
您還需要爲你想改變工作表名稱（Sheet1，Sheet2，Sheet3）和單元格範圍/需求它

然後簡單地自動填充下來，直到列A只顯示「0」（B列將循環不斷）
是v每一次改變都會被放入你的輸出中。 （什麼也可能是這種方法的缺點）也非常長的列表，這是更好地與額外的電池C1（或你想要什麼都CELL）和不包括前兩個第三代碼中使用它。

玩得開心:)

Answer 3

這裏是另一種方式來做到這一點 - 這次使用ADO創建輸出。這會在SQL中創建笛卡爾積或交叉連接。這樣做的效果是生成每個表單使用一行的每種可能的組合。

如果工作簿保存爲文件.XLSM這將工作。如果您使用的是舊.xls格式然後註釋掉了Excel 2007年起連接字符串，並刪除了Excel 97-2003連接字符串

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很容易的。在第三片，A2和向下複製到適合：

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

然後複製A2：中B A24到B2：將第三片材的B24，雙擊填充柄。