|
|
楼主 |
发表于 2018-3-17 13:41
|
显示全部楼层
之前左拼右凑写了以下代码做成有录入基础数据、提取查询数据、以查询结果生成K线图功能，现在因数据量越来越多，需按需求提取数据，所以要增加主帖功能，
原工作簿代码见以下：
Sub 查询()
Dim i, o, s, C, t
If Sheet3.Cells(2, "D") = "" Then
MsgBox "请输入产品型号"
Exit Sub
End If
Sheet3.Range("A8:y123").ClearContents
s = 8
For i = 1 To 1000
If Sheet2.Cells(i, "b") Like "*" & Sheet3.Cells(2, "d") & "*" Then
C = C + 1
Sheet3.Cells(s, "a") = Sheet2.Cells(i, "a") '日期
Sheet3.Cells(s, "b") = Sheet2.Cells(i, "b")
Sheet3.Cells(s, "c") = Sheet2.Cells(i, "z")
Sheet3.Cells(s, "D") = Sheet2.Cells(i, "D") '备注
' 项目
Sheet3.Cells(s, "E") = Sheet2.Cells(i, "E")
Sheet3.Cells(s + 1, "E") = Sheet2.Cells(i + 1, "E")
Sheet3.Cells(s + 2, "E") = Sheet2.Cells(i + 2, "E")
Sheet3.Cells(s + 3, "E") = Sheet2.Cells(i + 3, "E")
For t = 1 To 20
If Sheet2.Cells(i, t + 5) <> "" Then
Sheet3.Cells(s, t + 5) = Sheet2.Cells(i, t + 5)
Sheet3.Cells(s + 1, t + 5) = Sheet2.Cells(i + 1, t + 5)
Sheet3.Cells(s + 2, t + 5) = Sheet2.Cells(i + 2, t + 5)
Sheet3.Cells(s + 3, t + 5) = Sheet2.Cells(i + 3, t + 5)
End If
Next
s = s + 4
End If
Next
j = C
End Sub
Sub 返回()
Sheets("查询").Select
End Sub
Sub k图()
Dim i, u
Sheets("(Av-Vis)检测数据曲线图").Select
With ActiveSheet.ChartObjects(1)
.Activate
ActiveChart.ChartTitle.Text = Sheet3.Cells(8, "b") & " (Av-Vis)检测数据曲线图"
End With
For u = ActiveChart.SeriesCollection.Count To 1 Step -1
ActiveChart.FullSeriesCollection(1).Delete
Next
Dim t, E, C, g, l, s, k
C = 8
E = 8
For i = 1 To j
Sheet1.ChartObjects (1)
ActiveChart.ChartArea.Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(i).Name = Sheet3.Cells(C, "c") & Sheet3.Cells(C, "d")
C = C + 4
For l = 1 To 2
E = E + 1
For t = 6 To 26
If Sheet3.Cells(E, t) <> "" Then
If g = "" Then
g = g & Sheet3.Cells(E, t)
If l = 1 Then
If Sheet3.Cells(E, t) > s Then
s = Sheet3.Cells(E, t)
End If
End If
Else
g = g & "," & Sheet3.Cells(E, t)
End If
Else
Exit For
End If
Next
g = "{" & g & "}"
If l = 1 Then
ActiveChart.FullSeriesCollection(i).XValues = g
Else
ActiveChart.FullSeriesCollection(i).Values = g
End If
g = ""
Next
E = E + 2
Next
ActiveChart.Axes(xlCategory).MaximumScale = (Int(s / 10) + 1) * 10
End Sub
Sub 加行()
Dim i
For i = 1 To 5000
If Sheet2.Cells(i, "e") = "" Then
Range("A2:Z5").Select
Selection.Copy
Range("A" & i).Select
ActiveSheet.Paste
Sheet2.Range("A" & i & ":d" & i) = ""
Sheet2.Range("f" & i & ":Y" & i + 3) = ""
Exit For
End If
Next
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-3-17 09:07
