环流式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