Question

我再次......我有一些代码可以复制某个列中的单元格（来自“Convertor”表单）并将其粘贴到另一列（表单“Unallocated”）。然后将这些值（ID）用作参考点，将每行（记录）的其余单元格移动到我需要的正确位置。

但是我无法让代码连续将ID复制到空行中，这样它们就不会覆盖以前的集合。我认为这与行Master.Cells(rowB, colB) = yourData有关，但我无法弄明白。我尝试将rowB更改为相同xlUp以查找列中最后一个未使用的单元格（与lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row一样），但我无法使其工作。有什么想法吗？

当前代码：

Private Sub CommandButton21_Click()

Dim colA As Integer, colB As Integer
Dim rowA As Integer, rowB As Integer
Dim Master As Worksheet, Slave As Worksheet 'declare both

Application.ScreenUpdating = False

Set Master = ThisWorkbook.Worksheets("Unallocated")
Set Slave = ThisWorkbook.Worksheets("Convertor")

colA = 17 
colB = 29 

rowA = 1 
rowB = 1 

lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row 'This finds the last row of the data of the column FROM which i'm copying
For x = rowA To lastA 'Loops through all the rows of A
    yourData = Cells(x, colA)
    Master.Cells(rowB, colB) = yourData
    rowB = rowB + 1 'Increments the current line of destination workbook
Next x 'Skips to next row

For j = 1 To 5000 '(the master sheet)

    For i = 1 To 5000 '(the slave sheet) 'for first 1000 cells

        If Trim(Master.Cells(j, 29).Value2) = vbNullString Then Exit For 'if ID cell is blank exit

        If Master.Cells(j, 29).Value = Slave.Cells(i, 17).Value Then

            If IsEmpty(Slave.Cells(i, 3)) Then Exit Sub

            Master.Cells(j, 2).Value = Slave.Cells(i, 3).Value 'Move all other data based on the ID
            Master.Cells(j, 8).Value = Slave.Cells(i, 4).Value
            Master.Cells(j, 9).Value = Slave.Cells(i, 5).Value
            Master.Cells(j, 10).Value = Slave.Cells(i, 6).Value
            Master.Cells(j, 11).Value = Slave.Cells(i, 7).Value
            Master.Cells(j, 12).Value = Slave.Cells(i, 8).Value
            Master.Cells(j, 13).Value = Slave.Cells(i, 9).Value
            Master.Cells(j, 4).Value = Slave.Cells(i, 10).Value
            Master.Cells(j, 23).Value = Slave.Cells(i, 11).Value
            Master.Cells(j, 24).Value = Slave.Cells(i, 12).Value
            Master.Cells(j, 25).Value = Slave.Cells(i, 13).Value
            Master.Cells(j, 26).Value = Slave.Cells(i, 14).Value
            Master.Cells(j, 27).Value = Slave.Cells(i, 15).Value
            Master.Cells(j, 28).Value = Slave.Cells(i, 16).Value

            If Not IsEmpty(Slave.Cells(i, 3)) Then _
            Slave.Cells(i, 3).EntireRow.Delete 'deletes row after it has been copied

        End If
    Next

Next

Application.ScreenUpdating = True

End Sub

Answer 1

让我们从一个简单的循环开始，为每一行复制数据。然后你可以添加支票。

您可以使用workheet.range写入单元格（列行），例如（＆＃34; A4＆＃34;）或（＆＃34; A＆＃34;＆amp; counter）。

Private Sub CommandButton21_Click()
    Dim ws As Excel.Worksheet
    Dim wsMaster As Excel.Worksheet
    Dim strValue As String

    Set ws = ActiveWorkbook.Sheets("Convertor")
    Set wsMaster = ActiveWorkbook.Sheets("Unallocated")

    'Count of row to read from
    Dim lRow As Long
    lRow = 1

    'Count of row to write to
    Dim jRow As Long
    jRow = 1

    ws.Activate
    'Loop through and copy what is in the rows
    Do While lRow <= ws.UsedRange.Rows.count

        wsMaster.Range("AC" & jRow).Value = ws.Range("Q" & lRow).Value

        wsMaster.Range("B" & jRow).Value = ws.Range("C" & lRow).Value
        wsMaster.Range("H" & jRow).Value = ws.Range("D" & lRow).Value
        wsMaster.Range("I" & jRow).Value = ws.Range("E" & lRow).Value
        wsMaster.Range("J" & jRow).Value = ws.Range("F" & lRow).Value
        wsMaster.Range("K" & jRow).Value = ws.Range("G" & lRow).Value
        wsMaster.Range("L" & jRow).Value = ws.Range("H" & lRow).Value
        wsMaster.Range("M" & jRow).Value = ws.Range("I" & lRow).Value
        wsMaster.Range("D" & jRow).Value = ws.Range("J" & lRow).Value
        wsMaster.Range("W" & jRow).Value = ws.Range("K" & lRow).Value
        wsMaster.Range("X" & jRow).Value = ws.Range("L" & lRow).Value
        wsMaster.Range("Y" & jRow).Value = ws.Range("M" & lRow).Value
        wsMaster.Range("Z" & jRow).Value = ws.Range("N" & lRow).Value
        wsMaster.Range("AA" & jRow).Value = ws.Range("O" & lRow).Value
        wsMaster.Range("AB" & jRow).Value = ws.Range("P" & lRow).Value

        ws.Rows(lRow).EntireRow.Delete

        'Increment counters for both sheets. We can actually use just one counter, but if there is ever a condition that will cause us to not copy a row, then we will need two counters.
        jRow = jRow + 1
        'lRow = lRow + 1 'This is commented out because we are deleting rows after we copy them.

    Loop
End Sub

如果确实需要在复制后删除行，那么我们将不得增加lRow值。

Answer 2

.Cells限制了你的方法。

考虑更改为使用范围（“A1：C3000”）表示法它更强大。

Range.Select Range.Paste（到目的地的UsedRows.Count的新高分）

除非你有5000行，否则它并不准确，

实验

ActiveSheet.UsedRange.Rows.Count

如何在更改列时复制数据

2 个答案: