vba excel查找字符串，移動到偏移位置，將動態范圍復制到另一個工作表

Question

我以前所做的是手動選擇，然后將原始數據從報表中復制/粘貼到標題為“ ImportDump”的工作表中。 在這里，我使用VBA選擇並復制我感興趣的11個范圍到Sheet1和Sheet2中的特定位置。 我將在ImportDump工作表中明確說明數據所占據的范圍，並將其復制。 這可行，但不再簡單。

相反，我計划使用Find方法在ImportDump工作表中Find A列中的每個表標題，然后將Find的結果加上偏移量用作動態范圍的起始位置。 例如，在A30中找到了字符串“ Capital Premier”，但我需要的范圍從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），找到下一個空格之前的最后一行和最后一列，選擇偏移量位置，lastrow和lastcol概述的范圍，將范圍復制到在中定義的位置（Sheet，然后是Cell）與搜索字符串相對應的初始搜索表。 然后，它將遍歷所有其余的用戶定義的字符串，直到“指令”表中表格的最后一行，找到范圍並將其粘貼到相應的預定位置。 感謝大家的投入！

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