Question

最近几天我一直在研究此公式，并在这里为这个令人惊叹的社区提供了很多帮助，但遇到了一些问题。每次运行此程序，笔记本电脑几乎都崩溃了！

我想输入的所有数据并根据广告组名称创建关键字列表。

我不是宏的专家，但即使我知道这个公式也很笨拙，但不确定如何简化它。如果有人对如何简化下面的代码有任何想法，我将不胜感激。

' #Clears the content Rows 6:100 "Client View" to remove any old visualisations.

Sheets("Client View").Range("1:100").ClearContents


' #Copys and paste (transposed) values from Columns A,B,E,H,I in "CALCULATIONS" to the coresponding rows in "Client View". Last row is dynamic incase you have 1 or 1,000 ads.

LastCell = Sheets("CALCULATIONS").Range("A20000").End(xlUp).Row
Sheets("CALCULATIONS").Range("A2:A" & LastCell).Copy
Sheets("Client view").Range("A6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("CALCULATIONS").Range("B2:B" & LastCell).Copy
Sheets("Client view").Range("A7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("Client view").Range("A15").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("CALCULATIONS") .Range("I2:I" & LastCell).Copy
Sheets("Client view").Range("A8").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("CALCULATIONS").Range("E2:E" & LastCell).Copy
Sheets("Client view").Range("A9").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("CALCULATIONS").Range("H2:H" & LastCell).Copy
Sheets("Client view").Range("A13").PasteSpecial Paste:=xlPasteValues, Transpose:=True


' #Pastes the array formula in "Client View" A16 as the stem for generating the keyword lists for each Ad Group
Sheets("Client view").Range("A16").FormulaArray = "=IFERROR((INDEX(Keywords!$C:$C,SMALL(IF('Client view'!A$15=Keywords!$B:$B,ROW(Keywords!$B:$B)-ROWS(Keywords!$B$2)+1),ROW(1:1)))),"""")"

' #This drags the formula from A16 across to the last Ad Group and down to row 100
Dim lc As Long

With Worksheets("Client view")
lc = .Cells(15, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(16, "A"), .Cells(16, lc)).FillRight
.Range(.Cells(16, "A"), .Cells(100, lc)).FillDown
.Range(.Cells(16, "A"), .Cells(100, lc)).Copy
Range("A16").PasteSpecial xlPasteValues

Answer 1

也许您可以通过数组传输值，转置到目的地。

dim lr as long, lc as long, arr as variant, cv as worksheet

set cv = workSheets("Client view")

with workSheets("CALCULATIONS")

    lr = .cells(.rows.count, "A").end(xlup).row

    arr = .range(.cells(2, "A"), .cells(lr, "A")).value
    cv.cells(6, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)

    arr = .range(.cells(2, "B"), .cells(lr, "B")).value
    cv.cells(7, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)
    cv.cells(15, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)

    arr = .range(.cells(2, "I"), .cells(lr, "I")).value
    cv.cells(8, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)

    arr = .range(.cells(2, "E"), .cells(lr, "E")).value
    cv.cells(9, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)

    arr = .range(.cells(2, "H"), .cells(lr, "H")).value
    cv.cells(13, "A").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)

end with

With Worksheets("Client view")

    lc = .Cells(15, .Columns.Count).End(xlToLeft).Column

    with .range(.cells(16, "A"), .cells(100, lc))

        .formula = "=IFERROR(INDEX(KEYWORDS!$C:$C, AGGREGATE(15, 7, ROW(A:A)/(KEYWORDS!$B$1:INDEX(KEYWORDS!$B:$B, MATCH("zzz", KEYWORDS!$B:$B))=A$15), ROW(1:1))), TEXT(,))"

    end with

end with

是您的FormulaArray真正杀死了您的笔记本电脑。您需要一个更有效的公式。我看了看你的话，老实说并没有完全理解它，但是我将它改写为一种更有效的方法，并得出了与原始方法相同的结果。

如何简化宏

1 个答案: