使用条件复制/粘贴执行While循环-Excel VBA-代码不起作用

Question

我有一组复杂的要求，正在尝试开发适当的Excel VBA代码。我是一个初学者，因此，对此问题的任何建议将不胜感激。

上下文：“公司A”工作表列出了部门，薪级表和职位（A-C列）。 “公司B”表列出了上述所有职位，但在D和E列中，指定每个职位是否与公司A职位（D列）匹配，如果匹配，则为哪个职位（E列），或者是否不匹配，则列E单元格为空。

目标：我想将公司B中的工作与公司A中的工作进行匹配，并将匹配的公司B工作复制/粘贴到“公司A”工作表中，作为D-F列中的链接，但是有一个问题！

问题：在每个公司中，有多个职位具有相同的Department-Pay Grade-Job职称组合，并且这些数字在公司之间不匹配，例如公司A中有4个职位，但公司B中只有3个匹配职位。我想让我的代码知道只复制3次公司B职位，并将第四行留空（以可视方式指示三个匹配的职位，第四个没有匹配项）。为了实现这一点，我在每个公司的每个部门中具有相同薪水等级的职位数量，并希望将这些数量用作我的“ Do While”循环的计数器。

我写的代码：

 Private Sub CommandButton6_Click()

    Dim counter As Integer
    Dim myNum As Integer

    a = Worksheets("COMPANYB").Range("A" & Rows.Count).End(xlUp).Row
    Worksheets("JobNumbers").Range("D:D").Value = counter
    Worksheets("JobNumbers").Range("C:C").Value = myNum

    Do While counter < myNum
        For i = 2 To a
            If Worksheets("COMPANYB").Range("D" & i).Value = "Match" And _
            Worksheets("COMAPNYB").Range("E" & i).Value = Worksheets("COMPANYA").Range("C" & i).Value Then
            Worksheets("COMPANYB").Range("A" & i & ":C" & i).Copy
            Worksheets("COMPANYA").Activate
            b = Worksheets("COMPANYA").Range("D" & Rows.Count).End(xlUp).Offset(0, 3).Row
            Worksheets("COMPANYA").Range("D" & b + 1).Select
            ActiveSheet.Paste Link:=True
        End If
        Next i
        counter = counter + 1
        myNum = myNum - 1
    Loop
End Sub

...但是不起作用，它只是将所有0放入我的“ JobNumbers”工作表中的各个列中，从中我希望它带我的计数器和myNum设置Do While循环的测试。如您所见，我什至都没有想做的“复制时将行留空”的事情，因为我对此一无所知。我也开始怀疑我是否对VBA期望不高...

我确实认识到这是很多文字，我确实表示歉意-感谢您的反馈/帮助，谢谢！

Answer 1

=是赋值运算符。之所以在该列的每个单元格中写入“ 0”，是因为Worksheets("JobNumbers").Range("D:D").Value引用了整个列D中的每个单元格。然后，通过写入=，将变量counter分配给了所有这些单元格Worksheets("JobNumbers").Range("D:D").Value = counter >

此外，您将counter定义为Integer，但没有为其分配值=，因此它开始为空且不会更改。分配给单元格值的空整数将使该单元格保持为0。