如何将变量中的值粘贴到列中

Question

我需要编写一些代码来选择对应于另一列中各行的相等单元格值的最小单元格块。这是我所拥有的：

Function MoveDown(c)
    MoveDown = c.Offset(0, 1).Select
End Function

Sub LoanOptimization()
    For Each c In Worksheets("Sheet1").Range("C1:C65536").Cells
        c1 = c.Row
        Do While c.Value = MoveDown(c).Value
            c = MoveDown(c)
            c2 = MoveDown(c).Row
            Set CellRange = ActiveSheet.Range(Cells(c1, 12), Cells(c2, 12)).Select
            Minimum = Application.WorksheetFunction.Min(CellRange)
        Loop
    Next
    Range("N3").Select
    ActiveSheet.Paste
End Sub

1. 这对我正在尝试做的事情是否有意义，并且
2. 如何将最小值变量中的值粘贴到另一列中

编辑：

我更改并添加到我的代码中，因为我的第一个问题只是我需要做的第一步。这是我所拥有的，但我不断收到编译错误：

Dim lastRow As Integer
Dim i As Integer
Dim comp1 As Integer
Dim comp2 As Integer
Dim rngCount As Integer
Dim minimum As Integer
Dim comp3 As Integer
Dim comp4 As Integer

lastRowDate = WorksheetFunction.CountA(Range("G:G")) 'Find the last row with data
lastRowNotional = WorksheetFunction.CountA(Range("L:L"))
rngCount = 0

For i = 1 To lastRowDate
    comp1 = ActiveSheet.Cells(i, 7).Value 'Set comp1 equal to the Value of the cell in         Column C at the current row in the For loop
    comp2 = ActiveSheet.Cells(i + 1, 7).Value 'Set comp2 equal to the value of the cell just below it

    If comp1 <> comp2 Then 'If the values are different, i.e. we've found the last item in a series of matches
        minimum = Application.WorksheetFunction.Min(Range(Cells(i, 12), Cells(i - rngCount, 12))) 'Find the minimum of the range of cells
        'from Row i in Column D to Row i - rngCount (which is were our series of matches began)
        Cells(i, 14).Value = minimum 'Paste the found minimum in Column N, Row i
        rngCount = 0 'Because the values no longer match, reset our counter
        For j = 1 To lastRowNotional

        comp3 = ActiveSheet.Cells(i, 14)
        comp4 = ActiveSheet.Cells(i + 1, 14)
        offset1 = ActiveSheet.Cells(i - 1, 14)

            If (comp3 = offset1) And (comp3 <> comp4) Then 'If the selected cell is the last in a block of minima,
        'then we want to replace that cell only with sum of the values in that block
                Summation = Application.WorksheetFunction.Sum(Range(Cells(i, 12), Cells(i - rngCount, 12)))
            Cells(i, 14).Value = Summation
            End If
    Else 'If the values are the same
        rngCount = rngCount + 1 'increment our range counter until the values do not match
    End If
Next i

Answer 1

首先，学习 VBA 的最佳方法是启动宏记录器，在 GUI 中执行您想要的操作，然后查看生成的代码。我会建议尽可能多地这样做。

要将您的值粘贴到单元格 N3 中，请使用

Range("N3").Value = Minimum 'Or whatever you want to paste

在您提供的代码中，您从未复制过任何内容。如果你有你想要选择的值，你可以使用

Selection.Copy

复制它，然后像在代码中那样粘贴。在您的范围内，您可以使用 Range("C:C") 来选择整个列，而不是转到第 65536 行。这应该可以让您的代码正常工作。作为说明，我可能不会费心让 Movedown 成为它自己的功能。这是一行，所以你可以明确地使用它。

我没有测试过这段代码，但如果它在粘贴部分以外的地方工作，这应该可以修复它。如果您不确定问题出在哪里，请尝试使用

MsgBox c 'or any text or variable name

这将为您提供一个对话框，显示您在添加 MsgBox 行时的变量值。这通常有助于确定您的变量是否设置不正确，或者是否存在粘贴或显示问题。

希望这会有所帮助！祝你好运！

---

编辑：

这里的代码应该可以满足您的需求。我发表了大量评论，所以希望很清楚发生了什么，但如果没有，请告诉我。基本思想是有一个 For 循环，它检查 C 列中单元格的当前值与它下面的单元格，如果它们匹配，它会增加一个变量并跟踪一行中有多少相同的值。一旦找到不匹配的单元格，它就会通过第一个匹配的单元格找到当前单元格（在 D 列中）范围的最小值（这就是为什么我们要跟踪一行中有多少匹配。 )

我之前没有解释过，但是如果您不知道单撇号是 VBA 中的行注释字符。这意味着撇号后出现的任何内容都不会被程序读取，而只是供人类跟踪正在发生的事情。

Private Sub findMin()
Dim lastRow As Integer
Dim i As Integer
Dim comp1 As Integer
Dim comp2 As Integer
Dim rngCount As Integer
Dim minimum As Integer

lastRow = WorksheetFunction.CountA(Range("C:C")) 'Find the last row with data
rngCount = 0

For i = 1 To lastRow

    comp1 = ActiveSheet.Cells(i, 3).Value 'Set comp1 equal to the Value of the cell in Column C at the current row in the For loop
    comp2 = ActiveSheet.Cells(i + 1, 3).Value 'Set comp2 equal to the value of the cell just below it

    If comp1 <> comp2 Then 'If the values are different, i.e. we've found the last item in a series of matches
        minimum = Application.WorksheetFunction.Min(Range(Cells(i, 4), Cells(i - rngCount, 4))) 'Find the minimum of the range of cells from Row i in Column D to Row i - rngCount (which is were our series of matches began)
        Cells(i, 14).Value = minimum 'Paste the found minimum in Column N, Row i
        rngCount = 0 'Because the values no longer match, reset our counter
    Else 'If the values are the same
        rngCount = rngCount + 1 'increment our range counter until the values do not match
    End If
Next i

End Sub

除了我上面所说的最佳实践之外，还有一些注意事项：除非您有充分的理由使用 Select，否则请避免使用它。有很多原因，以及在本网站和其他网站上对它进行了一些冗长的讨论，但现在可以说它增加了不必要的长度和可能的混淆。 Cells(1,1).Select: Selection.Value = variableA 与 Cells(1,1).Value = variableA1 相同。当您可以使用.Value = 时，出于类似原因，我也会避免使用复制和粘贴。这更容易阅读，并且出错或无法按预期工作的机会更少。我还建议您大量注释您的代码，特别是如果您遇到问题并将其粘贴到此处。这将帮助其他人更好地了解您正在尝试做什么。即使它运行良好，最好发表评论，以防几个月后您需要更改它或其他人需要阅读它。进去是个好习惯。

---

编辑 2：

这应该是您正在寻找的。我试图评论我所做的更改，所以希望这是有道理的。就 For j 中的 If 语句而言，您已将其设置为检查单元格 j 是否与其上方的单元格匹配，以及它是否与其下方的单元格不同。但是，在 N 列中，第一个 For 循环only 将代码放在值不同的单元格上。每当值相同时，N 列中的相应单元格为空白。因此，检查 N 列是否具有正值将捕获包含数据的单元格并忽略空白单元格。您也可以只检查下一个单元格是否不同。如果您在每个单元格上检查这一点，则可以安全地假设前一个单元格是相同的。这就是我在第一个 For 循环中所做的。

Private Sub findMin()

Dim lastRow As Integer
Dim i As Integer
Dim comp1 As Integer
Dim comp2 As Integer
Dim rngCount As Integer
Dim minimum As Integer
Dim comp3 As Integer
Dim comp4 As Integer
Dim lastRowNotional As Integer
Dim j As Integer
Dim offset1 As Integer
Dim summation As Double 'I don't know how many items you are summing or how large they are, but if it's too large Integer won't work.  I needed to use Double for the sample data I made up

lastRowDate = WorksheetFunction.CountA(Range("G:G")) 'Find the last row with data
lastRowNotional = WorksheetFunction.CountA(Range("L:L")) 'Unless Columns G and L are different lengths, there is not a need to have a second variable
rngCount = 0

For i = 1 To lastRowDate
    comp1 = ActiveSheet.Cells(i, 7).Value 'Set comp1 equal to the Value of the cell in Column C at the current row in the For loop
    comp2 = ActiveSheet.Cells(i + 1, 7).Value 'Set comp2 equal to the value of the cell just below it

    If comp1 <> comp2 Then 'If the values are different, i.e. we've found the last item in a series of matches
        minimum = Application.WorksheetFunction.Min(Range(Cells(i, 12), Cells(i - rngCount, 12)))
        Cells(i, 14).Value = minimum 'Paste the found minimum in Column N, Row i
        rngCount = 0 'Because the values no longer match, reset our counter

    Else: comp1 = comp2 'If the values are the same
         rngCount = rngCount + 1 'increment our range counter until the values do not match
    End If
Next i

'I moved this whole For loop outside the other one so that it doesn't try to run for every new i
 'Also, you had i inside this loop, but your loop counter is j.  This is an easy mistake to make when using a lot of For loops
    For j = 1 To lastRowDate 'We want to only check as many rows in Column N as we output, which is equal to lastRowDate

         comp3 = ActiveSheet.Cells(j, 14).Value 'I added the .Value here

         If Cells(j, 14).Value > 0 Then 'This will throw an error when it tries to find the cell above row 1. Be careful of using row - 1 on functions that include the first row
        'Just checking to see if the cell's value is greater than zero should suffice
             summation = Application.WorksheetFunction.Sum(Range(Cells(j, 12), Cells(j - rngCount, 12)))
             Cells(j, 15).Value = summation 'I moved this to paste in Column O.  Otherwise it would paste over the minimum we just found, defeating the purpose of finding the minimum
             rngCount = 0 ' Don't forget to reset your counter here.....
        Else
             rngCount = rngCount + 1 '... or increment it here

        End If
    Next j 'Be sure to include Next j to move the loop forward

End Sub