vba excel 查找字符串，移动到偏移位置，将动态范围复制到另一个 sheet

Question

我之前一直在做的是手动 select 将报告中的原始数据 copy/paste 转换为标题为 "ImportDump" 的 sheet。从这里我使用 VBA 到 select 并将我感兴趣的 11 个范围复制到 Sheet1 和 Sheet2 中的特定位置。我会明确说明数据在 ImportDump sheet 中占据的范围并复制它们。这行得通，但不再简单。

相反，我计划使用 Find 方法在 ImportDump sheet 的 A 列中搜索每个 table 标题，然后使用 Find 的结果, 加上偏移量，作为动态范围的起始位置。因此，例如，字符串 "Capital Premier" 在 A30 中找到，但我需要的范围从 B33 开始。然后我需要所有行向下到 B 列中的下一个空白单元格，所有列到下一个空白列（数据总是在 J 列中完成）。然后重复所有其他 11 个标题字符串。标题将全部出现在 A 列中，所有 table 与搜索字符串结果 (3,1) 的偏移量相同，并且列数相同 (9)，但不一定相同行。

我想我知道如何进行搜索 IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart)，而且我很确定我可以使用 .End(xldown) 到 select 到下一个空白行，但是我'我不确定如何将所有这些与偏移量结合起来以表达我的动态范围的起始位置。有人可以帮我解决这个问题吗？

Answer 1

编辑：我找到了理想的解决方案（除非有人提出更好的解决方案）

这段代码结合了 table 对用户定义字符串 sheet ("Instructions") 的查看，在单独的 [=31= 中搜索字符串]（"ImportDump" - 原始数据转储），一旦找到字符串，它就会跳转到偏移单元格位置 (3,1)，找到下一个空白之前的最后一行和最后一列，selects由偏移位置 lastrow 和 lastcol 概述的范围将范围复制到初始搜索 table 中定义的与搜索字符串相对应的位置（Sheet，然后是 Cell）。然后循环遍历所有其余的用户定义字符串，直到 "Instructions" sheet 中 table 的最后一行，找到范围并将它们粘贴到相应的预定位置。感谢大家的参与！

Sub ImportLeagueTables()

Dim r As Range
Dim i As Integer
Dim IDump As Worksheet
Dim Instruct As Worksheet
Dim what1, where1, where2 As String
Dim TeamRng, TableRng, f, g As Range
Dim LastRowTeam As Long, Lastrow, Lastcol As Long

Set Instruct = Sheets("Instructions")
Set IDump = Sheets("ImportDump")
    LastRowTeam = Instruct.Range("M4").End(xlDown).Row

Set TeamRng = Instruct.Range("M4:O" & LastRowTeam)

i = 1

     For Each r In TeamRng.Rows 'rows to loop through

         what1 = TeamRng.Range("A" & i) 'the string to find
         where1 = TeamRng.Range("B" & i)
         where2 = TeamRng.Range("C" & i)

            Set f = IDump.Columns(1).Find(what1, LookIn:=xlValues, LookAt:=xlPart)
            Set g = f.Offset(3, 1)
            Lastrow = g.Range("A1").End(xlDown).Row
            Lastcol = g.SpecialCells(xlCellTypeLastCell).Column

            Set TableRng = IDump.Range(g, IDump.Cells(Lastrow, Lastcol))

                TableRng.Copy
                Sheets(where1).Range(where2).PasteSpecial xlValues

            i = i + 1

         Next r

End Sub

原始的、不太稳健的解决方案：好的，我通过参考第一个单元格即 Set g = f.Offset(3, 1) 和Set CapPremRng = g.Range("A1:I10")，尽管这并不像我想要的那样优雅。宁愿使用 g 来 select 所有单元格，直到下一个空白 row/column。

完整代码：

Sub DoMyJob()

Dim IDump As Worksheet
Dim f As Range
Dim g As Range
Dim CapPremRng As Range

Set IDump = Sheets("ImportDump")

Set f = IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Set CapPremRng = g.Range("A1:I10")

CapPremRng.Copy
Sheets("Sheet3").Range("A1" & LastRow).PasteSpecial xlValues

End Sub

vba excel 查找字符串，移动到偏移位置，将动态范围复制到另一个 sheet

vba excel Find string, move to an offset location, copy dynamic range to another sheet

excel

vba

dynamic

range

offset