Question

我完全是Excel VBA的新手！我有一项任务是在找到某些字符串时将工作表“作业”中的范围复制到工作表“Einfügen”。
我之前做过的是手动选择，然后将其从“作业”复制粘贴到“Einfügen”。我想使用VBA从“作业”中选择并复制可用19个范围中的6个范围（每个范围具有固定的行数1600，列可以是4或6），我将搜索每个表标题在“作业”表中的A列中使用Find方法，然后使用Find的结果和偏移量作为动态范围的起始位置。

例如，字符串“Av”在A8033中找到，但我需要的范围在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

excel vba - 将字符串特定的复制/粘贴到另一个工作表，其中所有范围都在另一个工作表中的特定范围内

1 个答案: