查找范围内的文本并将下一个Activecell.offset（1,1）16单元格复制到目标-Java 学习之路

我有一个范围I13到I6076 . 我首先开始I13单元格并在Range中找到匹配（“D12：D103333”） . 如果它在Col D中找到匹配，那么它应该从Col D单元偏移Activecell.offset（1,1）并将接下来的16个单元（垂直副本）复制到相应的I13行（水平粘贴） . 然后转到I14，依此类推 . 我创建了一个do while循环来查找范围Range（“D12：D103333”）中的单元格，但是如何偏移和复制接下来的16个单元格 . 然后去col I的下一个单元格 . 任何帮助将不胜感激 . 非常感谢 . 代码如下 .

Sub Kantar（）

Dim Category As String
i As Integer

Range("I13").Select
Do While Not IsEmpty(ActiveCell)
    Category = ActiveCell.Value
    Range("D12:D103333").Find(What:=Category, MatchCase:=True).Select


ActiveCell.Offset(1, 0).Select
Loop

结束子

2 回答

0

尝试做这样的事情：

1）一旦找到细胞， activecell.offset(1,1)

2）从那里，使用 activecell.address 和 activecell.address + 16 作为范围来做 range.copy

3）将活动单元格偏移到要粘贴的位置 .

4）使用转置粘贴特殊以水平移调（使用宏录制器向您显示如何不确定）

5）偏移回原始单元格（基于你最终的位置的坐标）

6）偏移1个单元并继续循环 . （你已经编码了）

我会给出实际代码，但我不是在PC上 . 希望这些步骤仍然有用，如果其他人不给你代码:)

回复于 2024-05-20T18:33:19+08:00

首先，我想感谢Busse为我提供合理的步骤来获得答案 . 这是超级有用的 . 所以我在下面复制我的代码，这可能会帮助几个有类似问题的用户 . 谢谢：））

Sub Kantar2()

    Dim Category As String, i As Long, FinalRow As Long
    Dim Rng As Range, MyCell As Range

    Application.ScreenUpdating = False
    i = 10
    FinalRow = Cells(Rows.Count, 4).End(xlUp).Row
    Set Rng = Range("I13:I6086")
    For Each MyCell In Rng
        Category = MyCell.Value
        Range(Cells(i, 4), Cells(FinalRow, 4)).Find(What:=Category, MatchCase:=True).Select
        i = ActiveCell.Row
        ActiveCell.Offset(1, 1).Select
        Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row + 15, 5)).Copy
        MyCell.Offset(0, 1).PasteSpecial Transpose:=True
    Next MyCell
    Application.ScreenUpdating = True
End Sub

回复于 2024-05-20T18:33:19+08:00

查找范围内的文本并将下一个Activecell.offset（1,1）16单元格复制到目标

2 回答

相关问题