excel vba-特定的復制/粘貼字符串到另一個工作表，其所有范圍都在另一個工作表中的特定范圍

Question

我完全是Excel VBA中的新手！
當找到某些字符串時，我有一個任務要復制從工作表“ Job”到工作表“Einfügen”的范圍。
我以前所做的是手動選擇，然后將其從“作業”復制粘貼到“Einfügen”。 我想使用VBA從“ Job”中的可用19個范圍中選擇並復制6個范圍（每個范圍具有固定數量的行，即1600，列可以是4或6），我將搜索每個表標題使用“查找”方法在“作業”表中的A列中輸入，然后使用查找結果加上偏移量作為動態范圍的起始位置。

因此，例如，在A8033中找到了字符串“ Av”，但是我需要的范圍從C8035開始。 這些字符串的位置也沒有固定在特定的行中，可以針對不同的輸入進行不同的排序。
因此，在這種情況下，我想首先在“作業”中找到“ Av”位置，在本例中為A8033，它有4行，然后選擇范圍C8035直到F9635 {F（8035 + 1600）}並復制粘貼到“Einfügen”中的固定范圍是C11：F1611。
然后重復所有其他6個標題字符串。 標題將全部顯示在列A中，所有表與搜索字符串結果的偏移量相同（2,2），列數相同（4或6），行數相同（1600）。 我嘗試了很多方法來解決它，但是不幸的是我找不到代碼。 如果您能幫助我解決問題，我將不勝感激。 我的6個字符串是：“ Av”，“ An”，“ Af”，“ Zi”，“ Ar”，“ LCL”。在Job中的表如下：

        A    B            C           D           E           F
8033    Av                                  
8034   Idx  [Hz]         DA 1        DA 2        DA 3        DA 4
8035    0   1,00E+06    -9,58E-01   -9,65E-01   -9,74E-01   -9,62E-01
8036    1   2,87E+06    -1,49E+00   -1,51E+00   -1,52E+00   -1,50E+00
8034    2   4,75E+06    -1,84E+00   -1,88E+00   -1,88E+00   -1,86E+00
8035    3   6,62E+06    -2,14E+00   -2,19E+00   -2,17E+00   -2,15E+00
8036    4   8,50E+06    -2,39E+00   -2,45E+00   -2,43E+00   -2,41E+00
8037    5   1,04E+07    -2,63E+00   -2,70E+00   -2,66E+00   -2,65E+00
8038    6   1,22E+07    -2,86E+00   -2,92E+00   -2,89E+00   -2,88E+00
8039    7   1,41E+07    -3,07E+00   -3,14E+00   -3,10E+00   -3,09E+00
.
.
9635   1600 3,00E+09    -6,07E+01   -5,51E+01   -8,11E+01   -4,92E+01

您可以在這里看到我的代碼：

Sub DoMyJob()

    Dim IDump As Worksheet
    Dim f As Range
    Dim g As Range
    Dim CapPremRng As Range
    Worksheets("Job").Activate
    Set IDump = Sheets("Job")

    Set f = IDump.Range("A1:A30488").Find(What:="Av", LookIn:=xlValues, LookAt:=xlPart)
    Set g = f.Offset(2, 2).Activate

    Set CapPremRng = g.Range("A1:I" & Lastrow)

    CapPremRng.Copy
    Sheets("Einfügen").Range("C11" & Lastrow).PasteSpecial xlValues

End Sub

Answer 1

嘗試以下（注釋）代碼：

Option Explicit

Sub DoMyJob()
    Dim f As Range
    Dim lastRow As Long
    Dim keyword As Variant

    Const KEYWORDS As String = "Av,An,Af,Zi,Ar,LCL" '<--| list your 'keyword' strings
    Const DATASETROWS As Long = 1600 '<--| define data set range fixed amount of rows
    Const DATASETCOLUMNS As Long = 6 '<--| define data set range maximum amount of columns
    Const COLUMNSOFFSETFROMKEYWORD As Long = 2 '<--| define data set range rows offset from keyword cell
    Const ROWSOFFSETFROMKEYWORD As Long = 2 '<--| define data set columns rows offset from keyword cell

    With Worksheets("Job") '<--| reference your data worksheet
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<--! reference its column "A" cells form row 1 down to last non empty one
            For Each keyword In Split(KEYWORDS, ",") 'loop through 'keywords' list
                Set f = .Find(What:=keyword, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) '<--| search referenced cells for current 'keyword'
                If Not f Is Nothing Then '<--| if 'keyword' found then...
                    Sheets("Einfügen").Range("C11").Offset(lastRow).Resize(DATASETROWS, DATASETCOLUMNS).Value = _
                    f.Offset(ROWSOFFSETFROMKEYWORD, COLUMNSOFFSETFROMKEYWORD).Resize(DATASETROWS, DATASETCOLUMNS).Value '<--| copy data set fixed range values
                    lastRow = lastRow + DATASETROWS '<--|update destination sheet pasting row
                End If
            Next keyword
        End With
    End With
End Sub