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

Question

我以前所做的就是手动选择并将原始数据从报表复制/粘贴到一个名为"ImportDump“的工作表中。在这里，我使用VBA选择和复制我感兴趣的11个范围到Sheet1和Sheet2中的特定位置。我将显式地声明数据在ImportDump表中所占的范围，并将它们复制过。这起作用了，但已经不再简单了。

相反，我计划使用ImportDump方法搜索Find表A列中的每个表标题，然后使用Find的结果加上一个偏移量作为动态范围的起始位置。例如，字符串“大写总理”是在A30中找到的，但我需要的范围从B33开始。然后，我需要所有行到B列中的下一个空白单元格，所有列跨到下一个空白列(数据总是在J列中完成)。然后对所有11个标题字符串重复。标题都将出现在A列中，所有表将具有与搜索字符串结果(3,1)相同的偏移量和相同的列数(9)，但不一定是相同的行数。

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

Answer 1

编辑:我找到了我理想的解决方案(除非有人想出更好的办法)

此代码结合查看一个表(“指令”)上的一个表(“指令”)中的一个用户定义的字符串、一个单独的工作表中的字符串搜索("ImportDump“--一个原始数据转储)，一旦发现该字符串跳转到一个偏移量单元格位置(3,1)，在下一个空白之前找到最后一行和最后一列，然后选择偏移位置、最后一行和最后一列，将范围复制到初始搜索表中定义的与搜索字符串相对应的位置(工作表，然后单元格)。然后循环遍历用户定义的字符串的所有其余部分，直到“指令”表中的表的最后一行，找到范围并将它们粘贴到相应的预定位置。谢谢大家的意见！

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选择所有单元格，直到下一个空白行/列。

完整代码：

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