Question

thx获取所有帮助和建议：我正在处理的代码，在列中找到具有特定值的单元格。我想，当宏回到原始工作表时，代码选择一个范围以复制和粘贴所述范围。该范围取决于它发现前面的值偏移（0，-1）并向右移动8列的单元格。例如：range（“A1：A8”）。选择，当A2是具有特定值的单元格时。

Dim r As Long 'Row number
            Dim c As Long 'Column number (A = 1, K = 11, etc.)
            r = Rng1.Row
            c = Rng1.Column
            With Sheets("Registro")
                .Range(.Cells(r, c - 1), .Cells(r, c + 8)).Cut
            End With
            With Sheets("Detaille Completo")
                NextFree = .Columns(3).SpecialCells(xlCellTypeBlanks).Cells(1, 1).Row
                .Cells(NextFree, 1).PasteSpecial xlPasteValues
            End With
            Sheets("Registro").Select

Answer 1

给这个旋转;首先分解你的代码：

ActiveCell.Value = ActiveCell.Value + numval
Application.Goto (ActiveWorkbook.Sheets("Registro")) 'Will nix this
ActiveSheet.Range("Rng1").Select 'AVOID SELECT/ACTIVATE
Range(Rng.Offset(0, 1)).Offset(RowOffSet:=0, ColumnOffset:=9).Select 
Selection.Copy 'Activity on the above 3 lines... let's Cut so you don't have to delete later (if i understand below)
Sheets("Detaille Completo").Select 'sheet change
NextFree = ActiveSheet.Range("C8:C" & Rows.count).Cells.SpecialCells(xlCellTypeBlanks).Row 'finding empty cell
ActiveSheet.Range("A" & NextFree).PasteSpecial xlPasteValues 'pasting
Sheets("Registro").Select
Set kopieren = ActiveCell 'Looks like you're clearing the contents... will change copy to cut so you don't have to go back
kopieren.Resize(kopieren.Rows.count, _
    kopieren.Columns.count - 9).Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Selection.ClearContents

现在更新：

Dim r as Long 'Row number
Dim c as Long 'Column number (A = 1, K = 11, etc.)
Dim j as Long 'Row of first available empty cell on Detaille Completo
ActiveCell.Value = ActiveCell.Value + numval
r = Rng1.Row
c = Rng1.Column
With Sheets("Registro")
    .Range( .Cells(r-1, c), .Cells(r+8, c+9).Cut 'Selected data is CUT from sheet
End With
With Sheets("Detaille Completo")
    j = 1
    Do until IsEmpty(.Cells(j,3).Value)
        j = j + 1
    Loop 
    .Cells(j, 1).PasteSpecial xlPasteValues 'Should only need first cell of range to paste
End With

阅读评论以获取详细信息。

根据不断变化的细胞定义范围

1 个答案: