Hỗ trợ code lên biểu đồ Scatter

[kientung]

Em chào tất cả anh chị.
Do công việc hàng ngày của em phải báo thực tích hàng ngày sản xuất được theo biểu đồ Scatter như dưới.
Hiện tại bên em có 12 máy (PRT-01 tới PRT-12 ), bình quân mỗi ngày sản xuất 11 tới 12 Lot. ( Cần tới 12 biểu đồ )
Chọn vùng dữ liệu hoàn toàn bằng tay, nên mong anh chị có thể giúp em chọn vùng dữ liệu và lên biểu đồ bằng Scatter ạ.
Em cảm ơn.

 

[ptm0412]

Tô khối dữ liệu 3 dòng từ cột J đến cột U rồi chạy code sau:

Sub DrawChart()
Dim SelectRng As String, Cols As Long, SeriesCnt As Long
Dim Rw1 As Long, Rw2 As Long, TRw As Long
    SelectRng = Selection.Address
    Cols = Selection.Column
    SeriesCnt = Selection.Columns.Count - 1
    TRw = Selection.Row
    Rw1 = TRw + 1
    Rw2 = Rw1 + 1
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines).Select
    With ActiveChart
        .SetSourceData Source:=Range(SelectRng)
        .PlotBy = xlColumns
        For i = 1 To SeriesCnt
            .FullSeriesCollection(i).Select
            Selection.Formula = _
            "=SERIES(Sheet3!R" & TRw & "C" & i + Cols & _
            ",Sheet3!R" & Rw1 & "C" & i + Cols & ":R" & Rw2 & "C" & i + Cols & _
            ",Sheet3!R" & Rw1 & "C" & Cols & ":R" & Rw2 & "C" & Cols & "," & i & ")"
            Selection.MarkerStyle = -4142
            Selection.Format.Line.EndArrowheadStyle = msoArrowheadStealth
        Next
        .Axes(xlValue).MinimumScale = 0.5
        .Axes(xlValue).MaximumScale = 0.7
        .Axes(xlValue).MajorUnit = 0.1
        .Axes(xlCategory).MaximumScale = 25
        .Axes(xlCategory).MajorUnit = 0.5
        .ChartTitle.Delete
        .ChartArea.Height = 100
        .ChartArea.Width = 800
        .ChartArea.Top = Cells(Rw2 + 2, Cols + 1).Top
        .ChartArea.Left = Cells(Rw2 + 2, Cols + 1).Left
    End With
End Sub

 

[VetMini]

Ba cái này phải tự code lấy, chỉ hỏi một vài chỗ bí.
Mỗi ngày mỗi chạy code sẽ xảy ra tật ỷ y. Code không tự viết lấy thì biết chỗ nào mà kiểm soát?

 

[kientung]

Tô khối dữ liệu 3 dòng từ cột J đến cột U rồi chạy code sau:

Sub DrawChart()
Dim SelectRng As String, Cols As Long, SeriesCnt As Long
Dim Rw1 As Long, Rw2 As Long, TRw As Long
    SelectRng = Selection.Address
    Cols = Selection.Column
    SeriesCnt = Selection.Columns.Count - 1
    TRw = Selection.Row
    Rw1 = TRw + 1
    Rw2 = Rw1 + 1
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines).Select
    With ActiveChart
        .SetSourceData Source:=Range(SelectRng)
        .PlotBy = xlColumns
        For i = 1 To SeriesCnt
            .FullSeriesCollection(i).Select
            Selection.Formula = _
            "=SERIES(Sheet3!R" & TRw & "C" & i + Cols & _
            ",Sheet3!R" & Rw1 & "C" & i + Cols & ":R" & Rw2 & "C" & i + Cols & _
            ",Sheet3!R" & Rw1 & "C" & Cols & ":R" & Rw2 & "C" & Cols & "," & i & ")"
            Selection.MarkerStyle = -4142
            Selection.Format.Line.EndArrowheadStyle = msoArrowheadStealth
        Next
        .Axes(xlValue).MinimumScale = 0.5
        .Axes(xlValue).MaximumScale = 0.7
        .Axes(xlValue).MajorUnit = 0.1
        .Axes(xlCategory).MaximumScale = 25
        .Axes(xlCategory).MajorUnit = 0.5
        .ChartArea.Height = 125
        .ChartArea.Width = 800
        .ChartArea.Top = Cells(Rw2 + 2, Cols + 1).Top
        .ChartArea.Left = Cells(Rw2 + 2, Cols + 1).Left
    End With
End Sub

Em cảm ơn anh nhiều ạ.

Bài đã được tự động gộp: 16/6/21

Ba cái này phải tự code lấy, chỉ hỏi một vài chỗ bí.
Mỗi ngày mỗi chạy code sẽ xảy ra tật ỷ y. Code không tự viết lấy thì biết chỗ nào mà kiểm soát?

Dạ vâng anh. Em có Record Macro để làm thử nhưng không đươc, em sẽ cố gắng học hỏi thêm.

 

[ptm0412]

Ba cái này phải tự code lấy, chỉ hỏi một vài chỗ bí.
Mỗi ngày mỗi chạy code sẽ xảy ra tật ỷ y. Code không tự viết lấy thì biết chỗ nào mà kiểm soát?

Anh thông cảm, riêng bài này vẽ bằng tay 1 biểu đồ, sửa tay 11 series cũng đã khó, huống chi phải vẽ 12 cái.