環流式Excel宏

Question

我不是太熟悉Excel的VBA宏，所以一直在尋找以下一些幫助：

創建模板，其中用戶將輸入的產品和用戶數量不受限制，創建矩陣的頂部有產品，用戶沿着左邊。

  Product 1 Product 2 Product 3 

用戶A
用戶1
用戶2
用戶3

有他們將使用 「x」 或1和0以表示被分配什麼樣的產品到每個用戶（可以是多個產品）。從那裏我需要一個宏（或可能是一個我被告知可以工作的公式）來爲每個用戶/產品組合填充一行。我需要一個循環宏來遍歷每一行，因爲使用該模板的人可以輸入多少個用戶/產品沒有限制。

用戶（第1列）產品（第2欄）

用戶A產品1

用戶A產品2

用戶1個產品2

用戶2產品3

用戶3產品3

用戶3產品2

Answer 1

這樣的事情？

Public Sub GetUserProductCombi() 
    Const clngRowProducts As Long = 1 'Row containing product 
    Const cintColUsers As Integer = 1 'Column containing users 
    Const cstrSheetNameTemplate As String = "template" 

    Dim lngRowCombi As Long 
    Dim shtTemplate As Worksheet 
    Dim shtCombi As Worksheet 
    Dim lngRowLastUser As Long 
    Dim intColLastProduct As Integer 
    Dim lngRow As Long 
    Dim intCol As Integer 
    Dim strProduct As String 
    Dim strUser As String 
    Dim strValue As String 

    Set shtTemplate = ThisWorkbook.Worksheets(cstrSheetNameTemplate) 
    Set shtCombi = ThisWorkbook.Worksheets.Add() 
    shtCombi.Name = "combi" 

    'Determine last row with user 
    lngRowLastUser = _ 
     shtTemplate.Cells(shtTemplate.Rows.Count, cintColUsers).End(xlUp).Row 

    'Determine last column product 
    intColLastProduct = _ 
     shtTemplate.Cells(clngRowProducts, shtTemplate.Columns.Count).End(xlToLeft).Column 

    lngRowCombi = 1 
    'Loop through all the cells 
    For lngRow = clngRowProducts + 1 To lngRowLastUser 
     For intCol = cintColUsers + 1 To intColLastProduct 
      'Get value 
      strValue = shtTemplate.Cells(lngRow, intCol) 
      'Check if value is other than empty (string) 
      If Trim(strValue) <> "" Then 
       'Determine product and user 
       strProduct = Trim(shtTemplate.Cells(clngRowProducts, intCol)) 
       strUser = Trim(shtTemplate.Cells(lngRow, cintColUsers)) 

       'Write to combi sheet if both user and product are not empty 
       If (strUser <> "") And (strProduct <> "") Then 
        shtCombi.Cells(lngRowCombi, 1) = strUser 
        shtCombi.Cells(lngRowCombi, 2) = strProduct 
        lngRowCombi = lngRowCombi + 1 
       End If 
      End If 
     Next intCol 
    Next lngRow 

    MsgBox "Finished" 
End Sub