VBA代码问题。。。

Sub CreateSharp()
Dim arr
Dim i%, j%
Dim sha, ab, sh As Worksheet, sht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name = "图表" Then
sh.Delete
End If
Next

Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
sht.Name = "图表"

sht.Range("A1").RowHeight = 90
sht.Range("A1:F1").Merge
sht.Range("A1").Value = "图表区"
sht.Range("a1").HorizontalAlignment = xlCenter
sht.Range("a1").Font.Size = 24
sht.Range("a1").Font.Name = "宋体"

arr = Sheets("sheet1").Range("A1").CurrentRegion
For j = 2 To UBound(arr, 2)
sht.Range("A" & j).RowHeight = 300
sht.Range("A" & j & ":H" & j).Merge
Next

For i = 2 To UBound(arr, 2)
Set sha = ActiveSheet.ChartObjects.Add(0, 0, 0, 0)
Set ab = sht.Range("A" & i & ":F" & i)
With sha
.Chart.ChartType = xlLine
.Chart.SetSourceData Source:=Sheets("sheet1").Range(Sheets("sheet1").Cells(2, i), Sheets("sheet1").Cells(UBound(arr), i))
.Chart.SeriesCollection(1).XValues = Sheets("sheet1").Range(Sheets("sheet1").Cells(2, 1), Sheets("sheet1").Cells(UBound(arr), 1))
.Chart.SeriesCollection(1).Name = Sheets("sheet1").Cells(1, i)
.Top = ab.Top
.Left = ab.Left
.Height = ab.Height
.Width = ab.Width
End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

第1个回答  2018-05-25
问题在哪呢?不说明谁一行一行给你调试啊追问

函数是没有问题的,就是现阶段是这种的

想改一下函数想让他宽一些然后想在数据源上面上面加一行变成这样

然后按出来之后变成这样

折线图要是可以改一下最好,带数据标记的折线图最好,谢谢

第2个回答  2018-05-24
啥问题,要帮忙吗
相似回答