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

How to paste values from a variable into a column

提问by aliencatbot

I needed to write some code that would select the minimum of blocks of cells that correspond to equal cell values across rows in another column. Here's what I have:

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

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. Does this even make sense for what I'm trying to do, and
2. How do I paste the values from my Minimum variable into another column

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

EDIT:

编辑：

I changed and added to my code, because my first question was just the first step in what I needed to do. Here is what I have, but I keep getting compile errors:

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

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

采纳答案by thunderblaster

To start, the best way to learn VBA is to start the macro recorder, do what you want in the GUI and then look at the resulting code. I would recommend doing that as much as possible.

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

To paste your value in cell N3, use

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

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

In the code you provided, you never copied anything. If you have the value you want selected, you can use

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

Selection.Copy

to copy it and then paste as you did in your code. In your range, you can use Range("C:C") to select the entire column instead of going to row 65536. This should get your code working. As a note, I probably wouldn't bother making Movedown its own function. It's one line, so you could just use it explicitly.

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

I have not tested this code, but if it was working other than the pasting portion, this should fix it. If you're not sure where it's having trouble, try using

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

MsgBox c 'or any text or variable name

This will give you a dialog box showing the value of your variable at the point you added the MsgBox line. This is often helpful to determine if your variable isn't being set properly or if there is an issue with pasting or displaying it.

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

Hope this helps! Good luck!

希望这可以帮助！祝你好运！

---

---

EDIT:

编辑：

Here's code that should do what you want. I commented heavily, so hopefully it's clear what is happening, but let me know if not. The basic idea is there's a For loop that is checking the current value of the cell in Column C against the cell just below it and if they match, it increments a variable and keeps track of how many of the same value are in a row. As soon as it finds cells that don't match, it finds the minimum of the range of the current cell (in Column D) through the first cell that matched (which is why we were keeping track of how many matched in a row.)

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

I didn't explain earlier, but if you didn't know the single apostrophe is a line comment character in VBA. That means anything appearing after the apostrophe is not read by the program and is just for humans to keep track of what is happening.

我之前没有解释，但如果您不知道单个撇号是 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

A few notes in addition to what I said above about best practices: Avoid using Select unless you have a good reason to use it. There's a number of reasons why and some lengthy discussions about it on this site and others, but for now suffice it to say that it adds length and possible confusion that is unnecessary. Cells(1,1).Select: Selection.Value = variableAis the same as Cells(1,1).Value = variableA1. I would also avoid using Copy and Paste for similar reasons when you can use .Value =. This is clearer to read and has fewer chances for things to go wrong or not work as you intended. I would also recommend that you comment your code heavily, especially if you are having trouble and paste it here. This will help others better understand what you were trying to do. Even if it works fine, it is a good idea to comment in case you need to change it months later or someone else needs to read it. It's a good habit to get in.

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

---

---

EDIT 2:

编辑2：

This should be what you're looking for. I tried to comment the changes I made, so hopefully it makes sense. As far as the If statement in For j goes, you had it set to check if cell j matched the cell above it and if it was different from the cell below it. However, in Column N, the first For loop onlyputs code on cells where the value is different. Whenever the value is the same, the corresponding cell in Column N is blank. So checking to see if Column N has a positive value in it will catch cells with data and ignore blank cells. You could also only check if the next cell is different. If you check this on every single cell, it can safely be assumed that the previous cell was the same. This is what I did in the first For loop.

这应该是你要找的。我试图评论我所做的更改，所以希望它是有道理的。就 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