如何在Excel中使用VBA合并两个（或更多）行？

Question

我想在Excel中使用VBA合并两行，以便使用因子x为所选行的组合值创建一个新行。

alpha 5 6 8 3 ... 
beta 10 1 5 7 ... 

随着α和β我想创建行ab70（X = 0.7）

ab70 6.5 4.5 7.1 4.2 ... 
(5*.7+10(1-.7)) ... 

我想从VBA选择的GUI从列表创建此的材料和艇员选拔的因子x。

感谢：d 大号

Answer 1

这个答案的第一个版本更关心的是澄清不是回答这个问题的要求。第二个版本更接近正确的答案。第一版中在评论中回答的问题已被删除。去除的问题

这之后

第一个版本是不是可以教你打造一个窗体，尽管你可以得到帮助，为控制代码的站点。尝试在网上搜索“excel vba userform tutorial”。有一个数字可供选择。我没有尝试过，所以不能提出建议。

列表框允许程序提供用户可以从中选择一个或多个项目的列表。组合框允许程序提供一个列表，用户可以从中选择一个项目或输入一个不在列表中的新值。你不希望用户能够指定他们自己的材料，所以你需要一个列表框。默认情况下，用户只能选择一个你想要的项目。

第二个版本

这会不会是一个完整的答案。我会给你设计的想法，然后你可以开发满足你的确切要求，或者你可以澄清你的要求，我会发展他们多一点。我会给你一些有用的代码，但不是你需要的完整解决方案。

你说，将两种材料结合起来可以满足你的直接需求，但是从长远来看，你希望结合更多。有不同的方法来解决这种情况：

1. 现在设计和实施解决方案的迫切需要。稍后重新设计。
2. 现在就为长期需求设计和实施解决方案。
3. 为长期设计解决方案，然后尽可能多地实施长期设计。

这些方法在任何情况下都不是正确的。如果你正在努力达到最后期限，那么接近1是唯一的选择。如果您缺乏技术方面的经验并希望简单实施作为培训练习，则方法1也可能适用。当我年轻时，向多个用户分发新版应用程序可能非常昂贵，方法2往往是首选方法。这些天，方法3通常是我的首选。

从你的意见，我推断你是喜欢思考的东西：

两个列表框填充材料的名称，以便用户可以在第一个列表框中单击一个行第二个指定两种材料。文本框允许用户输入比例和名称。我用蓝色的“Rem”表示您可能希望显示为注释的余数（1 - x）。你可能没有想到按钮。如果用户无意中启动宏，应始终有一个退出按钮。点击一个按钮保存混合物，用户可以先检查四个值。

我认为这可能是两个材质版本的优秀设计。如果我们忽略实际的行合并，那么这个表单背后的代码就会很少。

我不知道你的材料名称有多长，但我认为这种设计可以扩展为三种或四种材料，方法是在除最后一个列表之外的所有列表下方的比例文本框中向右添加额外的列表框。但是，这种安排在混合物中的材料最大数量会很低。如果您的最大值偏低，这将是可以接受的。您也可以允许使用者混合混合物，从而允许混合物中无限数量的基础材料。

允许三种或四种材料混合使用的表格背后的代码只比两种材质版本的复杂一点。

我有两种替代设计，可能会更好的材料的最大数量，但它不会概述，除非你指出这第一个设计是不可接受的。

我期望任何好的教程来解释加载列表框的值的各种方法，我不会重复它们。

---

但是，您决定处理材质及其比例的选择，您将需要一个例程来生成新行。

我创建了一个工作表“材料”，并建立了第几行和列这样：

我很欣赏你有更多的行和列，但我的数据是足够的测试和示范。标题行中的注意事项“Prop”是“Property”的缩写。

您需要告诉合并行的例程，哪些行要混合。用户将选择材料B2说。您可以将“B2”传递给例程，并让它发现它所来自的行，但这会使例程比编写代码更困难。当从这个工作表中加载列表框时，将从第2行到第12行的列A中获取值。我希望你的用户表单教程解释你的代码可以通过值（B2）或通过指数（第4行）。您知道列表框的第一行是从工作表的第2行加载的，因此您可以计算列表框的第4行是从工作表的第5行加载的。

您需要告诉例程用户输入的比例和混合物的名称。

上面我列出了三种可能的方法来决定要实施多少。对这些方法的补充是包含了不需要的灵活性，但是这种灵活性与排除一样简单或者更容易包含。

我例行的声明是：

Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _ 
        ByVal MaterialNameNew As String) 

你只会有一个工作表保温材料，它的名字是不可能改变的，所以我可以硬编码工作表的名称纳入常规。但是，使工作表名称成为参数几乎同样简单，我认为它使代码更加整洁，因此我已将其作为参数。

该例程要求数组Prop（）包含所有比例，包括最后一个。因此，例如（0.7,0.3）或（0.3,0.3,0.4）。用户表格将不得不计算最后一个比例，所以它不妨通过最后一个比例。我已经制作了Prop（）一系列的单打，我认为它会给你足够的精度。如果你不明白我能解释的最后一句话。请注意，这里“Prop”是比例的简称。很抱歉，将“Prop”用作“Property”和“Proportion”的缩写。直到我对本文进行最后检查时，我才注意到。

我需要一个例程来测试Sub RecordNewMixture，所以我提供了它作为演示。请注意，我已经编写并测试了这个例程，没有任何用户表单的参与。在将它们组合到成品中之前，开发和测试你的例程总是一个好主意。

运行宏后，工作表“材料”有两个新行：

如果重复使用公式的新行，你会发现，值是根据您的需要。

Option Explicit 
Sub Test() 

    Dim RowSrc() As Long 
    Dim Prop() As Single 

    ReDim RowSrc(0 To 1) 
    ReDim Prop(0 To 1) 

    RowSrc(0) = 2: Prop(0) = 0.7! 
    RowSrc(1) = 4: Prop(1) = 0.3! 

    Call RecordNewMixture("Material", RowSrc, Prop, "Join24") 

    ReDim RowSrc(1 To 3) 
    ReDim Prop(1 To 3) 

    RowSrc(1) = 3: Prop(1) = 0.3! 
    RowSrc(2) = 6: Prop(2) = 0.3! 
    RowSrc(3) = 9: Prop(3) = 0.4! 

    Call RecordNewMixture("Material", RowSrc, Prop, "Join369") 

End Sub 
Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _ 
        ByVal MaterialNameNew As String) 

    ' * RowSrc is an array containing the numbers of the rows in worksheet WshtName 
    ' that are to be mixed to create a new material. 
    ' * Prop is an array containing the proportions of each source material in the new 
    ' mixture. 
    ' * Arrays RowSrc and Prop must have the same lower and upper bounds. 
    ' * MaterialNameNew is the name of the mixture. 
    ' * Each data row in Worksheet WshtName defines a material. Column A contains the 
    ' name of the material. The remaining columns contain numeric properties of the 
    ' material. 
    ' Each data row in Worksheet WshtName must have the same maximum number of 
    ' columns. Call this value ColLast. 
    ' * This routine creates a new row below any existing rows within worksheet 
    ' WshtName. Call this row RowNew. The values in this new row are: 
    ' * Column A = MaterialNameNew 
    ' * For ColCrnt = 2 to ColMax 
    ' * Cell(RowNew, ColCrnt) = Sum of Cell(RowSrc(N), ColCrnt) * Prop(N) 
    '        for N = LBound(RowSrc) to UBound(RowSrc) 

    Dim ColCrnt As Long 
    Dim ColLast As Long 
    Dim InxRowSrc As Long 
    Dim RowNew As Long 
    Dim ValueNewCrnt As Single 

    Application.ScreenUpdating = False 

    With Worksheets(WshtName) 

    ' Locate the row before the last row with a value in column A 
    RowNew = .Cells(Rows.Count, "A").End(xlUp).Row + 1 

    ' Store name of new material 
    .Cells(RowNew, "A") = MaterialNameNew 

    ' Locate the last column in the first source row. Assume same 
    ' last column for all other source rows 
    ColLast = .Cells(RowSrc(LBound(RowSrc)), Columns.Count).End(xlToLeft).Column 

    For ColCrnt = 2 To ColLast 
     ' If Single does not give adequate precision, change the declaration of 
     ' Prop() and ValueNewCrnt to Double. If you do this, replace "0!" by "0#" 
     ValueNewCrnt = 0! 
     For InxRowSrc = LBound(RowSrc) To UBound(RowSrc) 
     ValueNewCrnt = ValueNewCrnt + .Cells(RowSrc(InxRowSrc), ColCrnt).Value * Prop(InxRowSrc) 
     Next 
     .Cells(RowNew, ColCrnt) = ValueNewCrnt 
    Next 

    End With 

    Application.ScreenUpdating = True 

End Sub