Excel thực hiện khá tốt việc chia tỷ lệ các trục biểu đồ của nó. Nhưng có những lúc bạn ước nó sẽ hoạt động tốt hơn. Một trường hợp được hiển thị trong biểu đồ phân tán XY bên dưới. Tất cả các điểm đều có giá trị X và Y trong khoảng từ 0 đến 7, nhưng vì bản thân biểu đồ là hình chữ nhật nên các đường lưới được đặt cách nhau dọc theo trục X và Y. Sẽ không đẹp hơn nếu khoảng cách giống nhau dọc theo cả hai trục, tạo cho bạn các đường lưới vuông?
Có một số cách để thực hiện điều này, không bao gồm phương pháp thủ công tẻ nhạt là nhấp và kéo bằng chuột hoặc thử một chuỗi các giá trị cho các giá trị cực đại của trục để cố gắng làm cho nó hoạt động. Tôi sẽ sử dụng VBA để xử lý tác vụ này
Đường lưới vuông bằng cách thay đổi tỷ lệ trục
Cách tiếp cận đầu tiên hoạt động bằng cách đo kích thước khu vực ô của biểu đồ, khóa các tham số tỷ lệ trục và sử dụng tỷ lệ để xác định khoảng cách giữa các đường lưới theo chiều ngang và chiều dọc. Sau đó, trục có khoảng cách lớn hơn sẽ tăng tối đa để khoảng cách giữa các đường lưới của nó co lại để khớp với khoảng cách trên trục vuông góc
Tôi đã viết chức năng này. chuyển vào biểu đồ bạn muốn bình phương và hàm sẽ thực hiện công việc của nó
Function SquareGridChangingScale[myChart As Chart]
With myChart
' get plot size
With .PlotArea
Dim plotInHt As Double, plotInWd As Double
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
' Get axis scale parameters and lock scales
With .Axes[xlValue]
Dim Ymax As Double, Ymin As Double, Ymaj As Double
Ymax = .MaximumScale
Ymin = .MinimumScale
Ymaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
With .Axes[xlCategory]
Dim Xmax As Double, Xmin As Double, Xmaj As Double
Xmax = .MaximumScale
Xmin = .MinimumScale
Xmaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
' Tick spacing [distance]
Dim Ytic As Double, Xtic As Double
Ytic = plotInHt * Ymaj / [Ymax - Ymin]
Xtic = plotInWd * Xmaj / [Xmax - Xmin]
' Keep plot size as is, adjust max scales
If Xtic > Ytic Then
.Axes[xlCategory].MaximumScale = plotInWd * Xmaj / Ytic + Xmin
Else
.Axes[xlValue].MaximumScale = plotInHt * Ymaj / Xtic + Ymin
End If
End With
End FunctionTôi sẽ mô tả một số cách để gọi chức năng này sau, nhưng hiện tại, dòng mã này sẽ ổn, trong phần phụ của riêng bạn hoặc chỉ trong Cửa sổ ngay lập tức
SquareGridChangingScale ActiveChartBiểu đồ bình phương được hiển thị bên dưới. Các đường lưới là hình vuông, được thực hiện bằng cách thay đổi trục X tối đa thành 12. 9777. Điều tốt là chúng tôi có VBA để tính toán điều này cho chúng tôi
Có một cạnh trống lạ trong biểu đồ, nhưng bạn có thể làm cho nó trông bớt lạ hơn bằng cách định dạng đường viền của khu vực biểu đồ để khớp với các trục
Hãy thử với một biểu đồ khác. Điều này giống như lần đầu tiên, nhưng các giá trị X lớn gấp đôi so với trước đây, dẫn đến một tỷ lệ khác
Đây là biểu đồ kết quả. Một lần nữa, các đường lưới là hình vuông và cạnh phải trông trống. Nhưng chúng tôi thấy một vấn đề khác. Khoảng cách đánh dấu trục X cách nhau 2 đơn vị, so với trục Y có khoảng cách 1 đơn vị
Buộc khoảng cách đơn vị chính bằng nhau
Tôi sẽ sửa đổi quy trình trước đó của mình bằng cách thêm một đối số tùy chọn EqualMajorUnit. Nếu đây là True, mã sẽ áp dụng cùng một khoảng cách cho cả hai trục trước khi điều chỉnh các giá trị tối đa của trục. Nếu nó là Sai hoặc bị bỏ qua, mã sẽ bỏ qua khoảng cách đánh dấu
Function SquareGridChangingScale[myChart As Chart, Optional EqualMajorUnit As Boolean = False]
With myChart
' get plot size
With .PlotArea
Dim plotInHt As Double, plotInWd As Double
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
' Get axis scale parameters and lock scales
With .Axes[xlValue]
Dim Ymax As Double, Ymin As Double, Ymaj As Double
Ymax = .MaximumScale
Ymin = .MinimumScale
Ymaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
With .Axes[xlCategory]
Dim Xmax As Double, Xmin As Double, Xmaj As Double
Xmax = .MaximumScale
Xmin = .MinimumScale
Xmaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If EqualMajorUnit Then
' Set tick spacings to same value
Xmaj = WorksheetFunction.Min[Xmaj, Ymaj]
Ymaj = Xmaj
.Axes[xlCategory].MajorUnit = Xmaj
.Axes[xlValue].MajorUnit = Ymaj
End If
' Tick spacing [distance]
Dim Ytic As Double, Xtic As Double
Ytic = plotInHt * Ymaj / [Ymax - Ymin]
Xtic = plotInWd * Xmaj / [Xmax - Xmin]
' Keep plot size as is, adjust max scales
If Xtic > Ytic Then
.Axes[xlCategory].MaximumScale = plotInWd * Xmaj / Ytic + Xmin
Else
.Axes[xlValue].MaximumScale = plotInHt * Ymaj / Xtic + Ymin
End If
End With
End FunctionĐây là biểu đồ của chúng tôi sau khi chạy phiên bản thứ hai của chức năng
Điều đó tốt hơn, các lưới vuông và có khoảng cách bằng nhau. Bây giờ cạnh chưa hoàn thành nằm dọc theo đầu biểu đồ. Một lần nữa, việc khớp màu của đường khu vực cốt truyện với các trục làm cho nó trông bớt khó xử hơn
Đường lưới ô vuông bằng cách thay đổi kích thước vùng ô
Chúng tôi đã đạt được các đường lưới vuông ở trên bằng cách giữ cố định khu vực ô và điều chỉnh tỷ lệ trục. Nhưng điều gì sẽ xảy ra nếu chúng ta thu nhỏ diện tích ô theo số lượng cần thiết để bình phương các đường lưới?
Đây là chức năng mới. Lưu ý rằng tôi đã giữ đối số EqualMajorUnit
Function SquareGridChangingPlotSize[myChart As Chart, Optional EqualMajorUnit As Boolean = False]
With myChart
' get plot size
With .PlotArea
Dim plotInHt As Double, plotInWd As Double
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
' Get axis scale parameters and lock scales
With .Axes[xlValue]
Dim Ymax As Double, Ymin As Double, Ymaj As Double
Ymax = .MaximumScale
Ymin = .MinimumScale
Ymaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
With .Axes[xlCategory]
Dim Xmax As Double, Xmin As Double, Xmaj As Double
Xmax = .MaximumScale
Xmin = .MinimumScale
Xmaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If EqualMajorUnit Then
' Set tick spacings to same value
Xmaj = WorksheetFunction.Min[Xmaj, Ymaj]
Ymaj = Xmaj
.Axes[xlCategory].MajorUnit = Xmaj
.Axes[xlValue].MajorUnit = Ymaj
End If
' Tick spacing [distance]
Dim Ytic As Double, Xtic As Double
Ytic = plotInHt * Ymaj / [Ymax - Ymin]
Xtic = plotInWd * Xmaj / [Xmax - Xmin]
' Adjust plot area size, center within space
If Xtic < Ytic Then
.PlotArea.InsideHeight = .PlotArea.InsideHeight * Xtic / Ytic
.PlotArea.Top = .PlotArea.Top + _
[.ChartArea.Height - .PlotArea.Height - .PlotArea.Top] / 2
Else
.PlotArea.InsideWidth = .PlotArea.InsideWidth * Ytic / Xtic
.PlotArea.Left = .PlotArea.Left + _
[.ChartArea.Width - .PlotArea.Width - .PlotArea.Left] / 2
End If
End With
End FunctionKhi chúng tôi chạy mã này, chúng tôi nhận được các đường lưới vuông không có phần mở rộng đường lưới ngộ nghĩnh và không có vùng trống lớn trong biểu đồ. Khu vực lô đất là trung tâm độc đáo
Điều này tốt hơn nhiều so với cách tiếp cận đầu tiên. Hãy xem cách nó hoạt động với các dữ liệu khác
Được rồi, chúng tôi đã quên sử dụng EqualMajorUnit = True, vì vậy lưới ô vuông có khoảng cách dấu khác nhau trên trục X và Y. Hãy thử lại lần nữa
Vâng, chức năng thứ hai này là một cải tiến lớn so với chức năng đầu tiên. Thậm chí có thể tốt hơn nếu đặt giá trị mặc định của EqualMajorUnit thành True
Đường lưới vuông bằng cách thay đổi kích thước biểu đồ
Khi chức năng thứ hai thay đổi kích thước khu vực biểu đồ, chúng tôi đã kết thúc với một chút khoảng trắng trong biểu đồ kết quả. Trong một số trường hợp, lượng khoảng trắng này là đáng kể. Điều gì sẽ xảy ra nếu chúng ta thu nhỏ toàn bộ biểu đồ, không chỉ khu vực ô và hấp thụ khoảng trắng thừa?
Function SquareGridChangingChartSize[myChart As Chart, Optional EqualMajorUnit As Boolean = False]
With myChart
' get plot size
With .PlotArea
Dim plotInHt As Double, plotInWd As Double
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
' Get axis scale parameters and lock scales
With .Axes[xlValue]
Dim Ymax As Double, Ymin As Double, Ymaj As Double
Ymax = .MaximumScale
Ymin = .MinimumScale
Ymaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
With .Axes[xlCategory]
Dim Xmax As Double, Xmin As Double, Xmaj As Double
Xmax = .MaximumScale
Xmin = .MinimumScale
Xmaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If EqualMajorUnit Then
' Set tick spacings to same value
Xmaj = WorksheetFunction.Min[Xmaj, Ymaj]
Ymaj = Xmaj
.Axes[xlCategory].MajorUnit = Xmaj
.Axes[xlValue].MajorUnit = Ymaj
End If
' Tick spacing [distance]
Dim Ytic As Double, Xtic As Double
Ytic = plotInHt * Ymaj / [Ymax - Ymin]
Xtic = plotInWd * Xmaj / [Xmax - Xmin]
' Adjust chart size
If Xtic < Ytic Then
.Parent.Height = .Parent.Height - .PlotArea.InsideHeight * [1 - Xtic / Ytic]
Else
.Parent.Width = .Parent.Width - .PlotArea.InsideWidth * [1 - Ytic / Xtic]
End If
End With
End Function
Một số cảnh báo áp dụng cho phương pháp này. Khi bạn thay đổi kích thước biểu đồ, tiêu đề biểu đồ có thể quyết định nó cần ngắt dòng, điều này sẽ thay đổi kích thước khu vực ô và làm cho các đường lưới không vuông. Dưới đây là kết quả của các biểu đồ của chúng tôi từ hai tập dữ liệu, mà không sửa lỗi khoảng cách đánh dấu không khớp của tập dữ liệu thứ hai
Đây là biểu đồ cho tập dữ liệu thứ hai, với EqualMajorUnit được đặt thành True
Đường lưới vuông bằng cách thay đổi kích thước biểu đồ
Cách duy nhất để cải thiện chức năng của tôi là bỏ qua chức năng đầu tiên và kết hợp hai chức năng cuối cùng, chuyển vào tham số
SquareGridChangingScale ActiveChart
Function SquareXYChartGrid[myChart As Chart, ShrinkChart As Boolean, _
Optional EqualMajorUnit As Boolean = False]
With myChart
' get plot size
With .PlotArea
Dim plotInHt As Double, plotInWd As Double
plotInHt = .InsideHeight
plotInWd = .InsideWidth
End With
' Get axis scale parameters and lock scales
With .Axes[xlValue]
Dim Ymax As Double, Ymin As Double, Ymaj As Double
Ymax = .MaximumScale
Ymin = .MinimumScale
Ymaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
With .Axes[xlCategory]
Dim Xmax As Double, Xmin As Double, Xmaj As Double
Xmax = .MaximumScale
Xmin = .MinimumScale
Xmaj = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If EqualMajorUnit Then
' Set tick spacings to same value
Xmaj = WorksheetFunction.Min[Xmaj, Ymaj]
Ymaj = Xmaj
.Axes[xlCategory].MajorUnit = Xmaj
.Axes[xlValue].MajorUnit = Ymaj
End If
' Tick spacing [distance]
Dim Ytic As Double, Xtic As Double
Ytic = plotInHt * Ymaj / [Ymax - Ymin]
Xtic = plotInWd * Xmaj / [Xmax - Xmin]
If ShrinkChart Then
' Adjust chart size
If Xtic < Ytic Then
.Parent.Height = .Parent.Height - .PlotArea.InsideHeight * [1 - Xtic / Ytic]
Else
.Parent.Width = .Parent.Width - .PlotArea.InsideWidth * [1 - Ytic / Xtic]
End If
Else
' Adjust plot area size, center within space
If Xtic < Ytic Then
.PlotArea.InsideHeight = .PlotArea.InsideHeight * Xtic / Ytic
.PlotArea.Top = .PlotArea.Top + _
[.ChartArea.Height - .PlotArea.Height - .PlotArea.Top] / 2
Else
.PlotArea.InsideWidth = .PlotArea.InsideWidth * Ytic / Xtic
.PlotArea.Left = .PlotArea.Left + _
[.ChartArea.Width - .PlotArea.Width - .PlotArea.Left] / 2
End If
End If
End With
End Function
Đây là cách bạn có thể gọi hàm từ một Phụ, xác định biểu đồ nào đã được chọn và áp dụng hàm cho từng biểu đồ