VBA代码用于复制两个特定文本之间的单元格集并进行转置

Question

首先，必须要感谢你们通过帮助像我这样的初学者来完成一项令人难以置信的工作。还可以在VBA Excel任务...

上请求其中一个查询的帮助

我正在寻找一个VBA代码来复制COLUMN1中的一组单元格存在于两个特定文本和TRANSPOSE之间，这组单元格存在于COLUMN2 ...

试图通过举例说明：

首先，VBA代码开始读取Column1 --- Row1，Row2，Row3等......

现在有一个名为＆＃34; CLICK＆＃34;在Row4 ....还有一些＆＃34;重要信息＆＃34;从Row5到Row8 ....还有一个名为＆＃34; VIEW＆＃34;在第9行......

但是我需要复制＆＃34;重要信息＆＃34; （COL5N1中的第5行到第8行）和从COLUMN2的TRANSPOSE到>第5行......

现在在Row9，Row10，Row11之后向前移动......还有文字＆＃34; CLICK＆＃34;在第12行重新出现.....并且＆＃34;重要信息＆＃34;从Row13到Row16 .....和文字＆＃34; VIEW＆＃34;在第17行....再次VBA代码将第二组单元格Row13复制到Row16，并将其转移到COLUMN2＆gt;第13行......

总体而言，COLUMN1中存在多个集合＆＃34; CLICK＆＃34;和＆＃34; VIEW＆＃34; .... VBA代码必须检查完整的COLUMN1并复制单元格集并将其转置到COLUMN2 ......

很抱歉，如果我的解释令人困惑，如果这看起来很难理解，请分享您的电子邮件，我可以通过电子邮件向您发送电子表格....感谢您的时间和帮助... PS：已附上图片Excel供您参考

Answer 1

如果您总是在下面四行找到要转置的文字“点击”，那么这样就可以了：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'Change the Sheet name above to the sheet you will be using
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A on your Sheet
For i = 1 To LastRow 'loop from row 1 to last
    FoundClick = InStr(ws.Cells(i, 1), "Click") 'check for text "Click" in cell
    If FoundClick > 0 Then ' if the text "Click" is found
        AddressFound = ws.Cells(i + 1, 1).Address 'get the address of where Click was found
        AddressFound = Replace(AddressFound, "$", "")
        AddressTo = ws.Cells(i + 4, 1).Address 'get the next four rows below where it was found
        AddressTo = Replace(AddressTo, "$", "")

        Range(AddressFound & ":" & AddressTo).Copy 'copy the range, the four rows below where "Click" was found

        ws.Cells(i, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        'transpose onto column B
    End If
Next i
End Sub