请帮忙做两个递增查找按钮，谢谢。

szzds01 · 发表于 2022-12-31 15:11

分别在对比结果那个表做两个按钮，按钮一：找出1205至1209强度评分是递增的（注：不以绝对值进行，直接以后一天的数值大于前一天进行，即：1209>1208>1207>1206>1205
按钮二：找出1205至1209强度评分有任意连续三天是递增的（注：不以绝对值进行，直接以后一天的数值大于前一天进行，即：1209>1208>1207或1207>1206>1205或1208>1207>1206

变动值2.rar (822.26 KB, 下载次数: 9)

蓝桥玄霜 · 发表于 2022-12-31 15:46

五连涨的例子：

szzds01 · 发表于 2022-12-31 21:51

蓝桥玄霜发表于 2022-12-31 15:46
五连涨的例子：

老师好，提示错误，能否再看一下。谢谢。

蓝桥玄霜 · 发表于 2023-1-1 09:38

x=Arr(i,1) & "|" & Arr(i,2)
&的前后都要有空格，另外逗号、冒号等都要用英文符号，不能用中文符号
有红色标注的句子都是有出错的地方
请仔细核对抄写的代码，初学者常常会抄错的。

szzds01 · 发表于 2023-1-1 13:10

蓝桥玄霜发表于 2023-1-1 09:38
x=Arr(i,1) & "|" & Arr(i,2)
&的前后都要有空格，另外逗号、冒号等都要用英文符号，不能用中文符号
有 ...

老师好，我仔细录入公式后运行报错，现上传文件，可否帮我看看，谢谢。

变动值3.rar (831.17 KB, 下载次数: 8)

蓝桥玄霜 · 发表于 2023-1-2 09:27

还有2个地方抄错：
1，Columns("A:A").NumberFormatLocal = "@" 在@后面多了个中文的 ”；
2，以前的附件有Sheet6，现在变成了Sheet7了。现在改为“对比结果”

Sub lqxs()
Dim Arr, i&, Brr(1 To 1000, 1 To 3), n%, ks, x$, y$, kk, tt, ii%
Dim d, k, t, m%
Set d = CreateObject("Scripting.Dictionary")
Dim Sht As Worksheet
For Each Sht In Sheets
If Sht.Name <> "对比结果" Then
Arr = Sht.[a1].CurrentRegion
y = Sht.Name
For i = 2 To UBound(Arr)
x = Arr(i, 1) & "|" & Arr(i, 2)
If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
d(x)(y) = Arr(i, 3)
Next
End If
Next
Sheets("对比结果").Activate
[a:c].ClearContents
Columns("A:A").NumberFormatLocal = "@"
k = d.keys: t = d.items
For i = 0 To UBound(k)
bb = Split(k(i), "|")
kk = t(i).keys: tt = t(i).items
ks = tt(0): n = 1: ss = ks
For ii = 1 To UBound(tt)
If tt(ii) >= ks Then
n = n + 1
ks = tt(ii): ss = ss & "-" & ks
Else
GoTo 100
End If
Next
m = m + 1
Brr(m, 1) = bb(0): Brr(m, 2) = bb(1): Brr(m, 3) = ss
100:
Next
If m > O Then [a2].Resize(m, 3) = Brr
End Sub

复制代码

szzds01 · 发表于 2023-1-2 21:27

蓝桥玄霜发表于 2023-1-2 09:27
还有2个地方抄错：
1，Columns("A:A").NumberFormatLocal = "@" 在@后面多了个中文的 ”；
2，以前的附 ...

谢谢版主的解答

		自动登录	找回密码
密码			免费注册

[求助] 请帮忙做两个递增查找按钮，谢谢。