Question

我有一个表，用户可以在多个列上插入多行，其中一些数据是字符串，一些是数字。我想创建一个按钮，当用户单击它时，它将在同一个Excel工作表上创建一个新表，但是根据预定义的条件组合了一些行。例如。表“预定义条件”表明alpha和gamma是相似的等等（它可以像这样显示组合行的条件。条件将始终属于用户定义表的第二行，即表1）。 ..表1将由不同的用户创建，他可以输入任意数量的行。因此，使用这两个表（表1和预定义条件表）我想创建一个新表，其中某些行与字符串相结合，使用“/”分隔两行并添加数字。所有表格的结构都保持不变。

编辑：第2列中的一个值在第1列中始终具有相同的值。基本上，第2列是从属列表（在第1列上）。可以有许多预定义的条件，而不仅限于2。通常第2列中不会有任何重复值，但是如果有，我想在点击按钮时将它们组合成一行。

Table 1

阿尔法100 1 B Beta 200 2
C Gamma 300 3
D Kappa 400 4

预定义条件
Alpha Gamma
Beta Kappa

Desired Output

A / C Alpha / Gamma 400 4
B / D Beta / Kappa 600 6

Answer 1

假设您的数据以A2：D2（A1：D1左侧为标题）开始，您在F和G列中指出两个条件（例如Alpha Gamma）（从第二行开始;标题左侧第一行），有一个命令按钮，并且工作表名为＆＃34; Sheet1＆＃34;，以下代码应该可以解决问题。

Dim i As Integer
Dim j As Integer
Dim lLastRowPDC As Integer
Dim lLastRowData As Integer
Dim sConditions As String
Dim sOrigin As String
Dim sColumnA As String
Dim sColumnB As String
Dim iColumnC As Integer
Dim iColumnD As Integer


Private Sub CommandButton1_Click()
lLastRowPDC = Worksheets("Sheet1").Cells(2, 6).End(xlDown).Row 'Rows with Conditions, starting in the second row
lLastRowData = Worksheets("Sheet1").Cells(2, 1).End(xlDown).Row 'Rows with data, starting in the second row

For i = 2 To lLastRowPDC
    sConditions = Worksheets("Sheet1").Cells(i, 6).Value & Worksheets("Sheet1").Cells(i, 7).Value 'create a string with the two conditions
    sColumnA = ""
    sColumnB = ""
    iColumnC = 0
    iColumnD = 0
    For j = 2 To lLastRowData
        sOrigin = Worksheets("Sheet1").Cells(j, 2).Value
        If InStr(sConditions, sOrigin) > 0 Then
            If InStr(sColumnA, Worksheets("Sheet1").Cells(j, 1).Value) = 0 Then
                sColumnA = sColumnA & Worksheets("Sheet1").Cells(j, 1).Value & "/"
            End If
            If InStr(sColumnB, Worksheets("Sheet1").Cells(j, 2).Value) = 0 Then
                sColumnB = sColumnB & Worksheets("Sheet1").Cells(j, 2).Value & "/"
            End If
            iColumnC = iColumnC + Worksheets("Sheet1").Cells(j, 3)
            iColumnD = iColumnD + Worksheets("Sheet1").Cells(j, 4)
        End If
    Next j
    sColumnA = Left(sColumnA, Len(sColumnA) - 1) 'remove last "/"
    sColumnB = Left(sColumnB, Len(sColumnB) - 1) 'remove last "/"
    Worksheets("Sheet1").Cells(i, 8).Value = sColumnA
    Worksheets("Sheet1").Cells(i, 9).Value = sColumnB
    Worksheets("Sheet1").Cells(i, 10).Value = iColumnC
    Worksheets("Sheet1").Cells(i, 11).Value = iColumnD
Next i

End Sub

根据预定义的条件

1 个答案: