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