循环Excel宏

时间:2014-10-03 09:49:51

标签: excel-vba excel-formula vba excel

我对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

1 个答案:

答案 0 :(得分:0)

这样的东西?

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