Excel VBA复制和粘贴循环

时间:2017-07-14 15:14:52

标签: vba excel-vba excel

我正在尝试复制和粘贴一系列单元格。我有单元格D1:D10,需要复制D1并粘贴A1:A20,然后移动到D2并粘贴它A21:A40,依此类推。我已成功通过A1:A20粘贴D1。我不知道如何让它移动到下一个单元格。 (“CountofResponses”)等于20.

Private Sub CommandButton1_Click()

Dim i As Integer
Range("D1").Select
Selection.Copy
For i = 1 To Range("CountofResponses")
   Range("A" & 1 + i).Select
   ActiveSheet.Paste
Next i

End Sub

2 个答案:

答案 0 :(得分:2)

试试这个

Private Sub CommandButton1_Click()

Dim r As Range

For Each r In Range("D1:D10")
    Range("A" & 1 + (r.Row - 1) * 20).Resize(Range("CountofResponses")).Value = r.Value
Next i

End Sub

答案 1 :(得分:0)

重写这一点,因为我误解了第一部分。你正在寻找一个名为OFFSET的VBA函数。有更有效的方法来实现你的整体目标,不使用复制/粘贴,但为了一个确切的答案...在这里你去:

def initUI(self):
    self.resize(1000,600)
    self.center()
    self.setWindowTitle('Browser')

    self.lb = QtGui.QLabel(self)
    pixmap = QtGui.QPixmap("test.png")
    height_of_label = 100
    self.lb.resize(self.width(), height_of_label)
    self.lb.move(0, self.height() -self.lb.height())
    self.lb.setPixmap(pixmap.scaled(self.lb.size(), QtCore.Qt.IgnoreAspectRatio))
    self.show()    

def resizeEvent(self, event):
    self.lb.resize(self.width(), self.lb.height())
    self.lb.setPixmap(self.lb.pixmap().scaled(self.lb.size(), QtCore.Qt.IgnoreAspectRatio))
    self.lb.move(0, self.height() -self.lb.height())
    QtGui.QWidget.resizeEvent(self, event)