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

这对我正在尝试做的事情是否有意义，
如何将我的Minimum变量中的值粘贴到另一列

编辑：

我改变并添加到我的代码中，因为我的第一个问题只是我需要做的第一步。这是我的，但我一直在编译错误：

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循环仅将代码放在值不同的单元格上。只要值相同，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

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

1 个答案: