删除除已定义列表外的所有命名范围

时间:2019-09-27 16:15:08

标签: excel vba

我正在寻求从excel文件中删除所有命名范围,但已定义的命名范围列表(大约1000)除外。基本上,如果有任何选项卡被复制到文件中,我想删除随着时间的推移已复制的所有内容,并且仅保留原始的命名范围。

我尝试将一些代码放到下面,但是我在VBA中不够先进,无法理解我要去哪里。当前,它在rName.Delete行给了我一个错误,我想以某种方式添加一个数组,以使列表不删除而不是在代码中单独定义。

strategy(shorttitle = "Squeeze MOM", title="Squeeze Momentum on Reversal Strategy", overlay=false)

len = input(title="Length", type=integer, defval=14)
th = input(title="threshold", type=integer, defval=20)

TrueRange = max(max(high-low, abs(high-nz(close[1]))), abs(low-nz(close[1])))
DirectionalMovementPlus = high-nz(high[1]) > nz(low[1])-low ? max(high-nz(high[1]), 0): 0
DirectionalMovementMinus = nz(low[1])-low > high-nz(high[1]) ? max(nz(low[1])-low, 0): 0


SmoothedTrueRange = nz(SmoothedTrueRange[1]) - (nz(SmoothedTrueRange[1])/len) + TrueRange
SmoothedDirectionalMovementPlus = nz(SmoothedDirectionalMovementPlus[1]) - (nz(SmoothedDirectionalMovementPlus[1])/len) + DirectionalMovementPlus
SmoothedDirectionalMovementMinus = nz(SmoothedDirectionalMovementMinus[1]) - (nz(SmoothedDirectionalMovementMinus[1])/len) + DirectionalMovementMinus

DIPlus = SmoothedDirectionalMovementPlus / SmoothedTrueRange * 100
DIMinus = SmoothedDirectionalMovementMinus / SmoothedTrueRange * 100
DX = abs(DIPlus-DIMinus) / (DIPlus+DIMinus)*100
ADX = sma(DX, len)

length = input(30, title="BB Length")
mult = input(3.0,title="BB MultFactor")
lengthKC=input(30, title="KC Length")
multKC = input(1.0, title="KC MultFactor")
strength = input(0.0018, title="Reversal Strength")

useTrueRange = input(true, title="Use TrueRange (KC)", type=bool)

// Calculate BB
source = close
basis = sma(source, length)
dev = multKC * stdev(source, length)
upperBB = basis + dev
lowerBB = basis - dev

// Calculate KC
ma = ema(source, lengthKC)
range = atr(length)
rangema = ema(range, lengthKC)
upperKC = ma + rangema * multKC
lowerKC = ma - rangema * multKC

sqzOn  = (lowerBB > lowerKC) and (upperBB < upperKC)
sqzOff = (lowerBB < lowerKC) or (upperBB > upperKC)

highest = highest(high, lengthKC)
lowest = lowest(low, lengthKC)
lastsma = ema(close,lengthKC)

valin = linreg(source  -  avg(avg(highest, lowest), lastsma), lengthKC,0)

bcolor = iff( valin > 0, iff( valin > nz(valin[1]), lime, green), iff( valin < nz(valin[1]), red, maroon))
scolor = sqzOn ? black : gray 
plot(valin, color=bcolor, style=histogram, linewidth=4)
plot(0, color=scolor, style=circles, linewidth=2)

longcondition = valin > strength and valin > nz(valin[1])  and DIPlus > DIMinus and DX > 15 and strategy.closedtrades < 1000  and (sqzOn[1] or sqzOn[2]or sqzOn[3] or sqzOn[4]) // line become maroon
shortcondition = valin < strength and valin < nz(valin[1]) and DIPlus < DIMinus and DX > 15 and strategy.closedtrades < 1000 and (sqzOn[1] or sqzOn[2]or sqzOn[3] or sqzOn[4]) // line become green
exitlong = valin < nz(valin[1]) and strategy.closedtrades < 1000
exitshort = valin > nz(valin[1]) and strategy.closedtrades < 1000

if(longcondition)
    strategy.entry("BUY", strategy.long, qty = (strategy.equity/(close*1.01)))
strategy.exit("BUY TO COV", "BUY", trail_price = strategy.position_avg_price, trail_offset = (.8*range*100))
strategy.close("BUY", when = exitlong)
if(shortcondition)
    strategy.entry("SELL", strategy.short, qty = (strategy.equity/(close*1.01)))
strategy.exit("SELL TO COV", "SELL", trail_price = strategy.position_avg_price, trail_offset = (.8*range*100))
strategy.close("SELL", when = exitshort)

1 个答案:

答案 0 :(得分:1)

在遍历集合并删除项目时,[可能-参见上面的讨论]最好从头到尾进行工作,即类似这样的事情:

Sub DeleteNamedRanges()

    Dim n As Long, arrKeep

    'names to not delete
    arrKeep = Array("keepThis", "andThis", "meToo")

    Application.Calculation = xlCalculationManual

    For n = ActiveWorkbook.Names.Count To 1 Step -1
        With ActiveWorkbook.Names(n)
            'is this name a keeper?
            If IsError(Application.Match(.Name, arrKeep, 0)) Then
                On Error Resume Next 'ignore any errors
                .Delete
                On Error Goto 0      'stop ignoring errors
            End If
        End With
    Next n

    Application.Calculation = xlCalculationAutomatic

End Sub