Как вставить значения из переменной в столбец

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. Как вставить значения из моих минимальных переменных в другую колонку

EDIT:

Я изменил и добавил к своему коду, потому что мой первый вопрос был только первым шагом в том, что мне нужно было сделать. Вот что у меня есть, но я получаю ошибки компиляции:

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, чтобы начать записи макросов, делать то, что вы хотите в графическом интерфейсе, а затем посмотреть на полученный код , Я бы рекомендовал сделать это как можно больше.

Чтобы вставить значение в ячейке 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 линию. Это часто помогает определить, не установлена ​​ли ваша переменная неправильно или если есть проблема с вставкой или ее отображением.

Надеюсь, это поможет! Удачи!

---

EDIT:

Вот код, который должен делать то, что вы хотите. Я прокомментировал это, так что, надеюсь, ясно, что происходит, но дайте мне знать, если нет. Основная идея заключается в том, что существует цикл 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 

Несколько замечаний в дополнение к тому, что я говорил выше о передовой практике: Избегайте использования Выберите, если у вас есть хороший повод, чтобы использовать его. Существует ряд причин, почему и некоторые длительные дискуссии об этом на этом сайте и другие, но на данный момент достаточно сказать, что он добавляет длину и возможную путаницу, которая не нужна. Cells(1,1).Select: Selection.Value = variableA - это то же самое, что и Cells(1,1).Value = variableA1. Я бы также избегал использования Copy and Paste по тем же причинам, когда вы можете использовать .Value =. Это яснее читать и имеет меньше шансов на то, что все пойдет не так или не будет работать так, как вы планировали. Я бы также рекомендовал вам сильно прокомментировать ваш код, особенно если у вас возникли проблемы и вставьте его здесь. Это поможет другим лучше понять, что вы пытались сделать. Даже если это хорошо работает, рекомендуется прокомментировать, если вам нужно изменить его через несколько месяцев, или кому-то еще нужно его прочитать. Это хорошая привычка в

---

EDIT 2:.

Это должно быть то, что вы ищете. Я попытался прокомментировать изменения, которые я сделал, поэтому, надеюсь, это имеет смысл. Что касается инструкции If в For j, вы должны установить, что ячейка 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