Умножаю данные на нужные мне числа

Question

Я немного не понимаю, как исправить этот код.

то, что происходило с этим, я всегда продолжаю писать число во всплывающем окне, вместо этого я делаю то же самое. Я хочу щелкнуть по весу «кнопку умножения диапазона» и умножить напрямую вместо ввода текста во всплывающую кнопку

поэтому я сделал пример Repro:

1st I pasted the highlight blue  
2nd I have select the range which I want to multiply
3rd I click the weight range multiply 
4th Since I want to multiply it to three so  
    I type three in the pop-up box and and click **OK** 
    so the the result can be found in the highlighted in RED

So this time 
What I want to happen is that 
1st I will select the blue 
2nd I will click the button **weight range multiply** 
    it will automatically multiply in to 3 and the 3 is referring to some 
    specific cells(let say column **G**). 

может кто-нибудь мне с этим помочь? и заранее спасибо

Это код

Private Sub CommandButton1_Click()
Dim NumberMe As Integer
Dim oRng As Range
Set oRng = Selection
oRng.Copy
NumberMe = InputBox("Multiply by?")
For i = 1 To NumberMe
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next i
End Sub

Заранее большое спасибо, ребята

Answer 1

Я не уверен, что понял вашу точку зрения, но, как я понял, вам нужно копировать (а не умножать) свой диапазон данных определенное количество раз. Я не могу видеть положение вашей ячейки, так как оно вырезано из вашего скриншота.

В моем примере ваш номер 3 находится в ячейке ThisWorkbook.Worksheets("Sheet1").Range("M2").Value. Мои данные находятся в A3:B17, поэтому мы указываем начальную ячейку как Set StartCell = Range("A3")

Вот код, который скопирует ваш диапазон определенное количество раз:

Sub CommandButton()

    Dim NumberMe As Integer
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell As Range
    Dim i As Long

    Set sht = ThisWorkbook.Worksheets("Sheet1")
    Set StartCell = Range("A3")

    NumberMe = ThisWorkbook.Worksheets("Sheet1").Range("M2").Value

    'Find Last Row and Column
    LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

    'Copy Range
    sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Copy

    For i = 1 To NumberMe
        sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next

End Sub

Вы можете редактировать это в соответствии с вашими потребностями.

---

EDIT:

Если вам нужно выбрать диапазон до столбца номер . Попробуйте это (замените sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Copy) на:

sht.Range(StartCell, sht.Cells(LastRow, 2)).Copy

В этом случае номер столбца 2. Тогда вам не нужны LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column и Dim LastColumn - их можно удалить из кода.

Окончательный результат будет выглядеть так:

Sub CommandButton()

    Dim NumberMe As Integer
    Dim LastRow As Long
    Dim StartCell As Range
    Dim i As Long

    Set sht = ThisWorkbook.Worksheets("Sheet1")
    Set StartCell = Range("A3")

    NumberMe = ThisWorkbook.Worksheets("Sheet1").Range("M2").Value

    'Find Last Row
    LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row

    'Copy Range
    sht.Range(StartCell, sht.Cells(LastRow, 2)).Copy

    For i = 1 To NumberMe
        sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next

End Sub