1

散布図にプロットするセルをいくつか選択できるマクロをコーディングしようとしています。

しかし、現在、チャート作成のためにセルエントリを選択した場所からシート名をハードコードすることしかできません。

ハードコーディングを変更して、動的なシート参照を可能にしたいと考えています。

これにより、異なるシートから複数のセルを選択し、それらの値を散布図にプロットできるようになります。

あなたのアドバイスのために以下のコードを添付します。ハードコードされたシート名に関する TQ 問題: .Name = "='US Sector (2)'!" & MultiSel.Address(ReferenceStyle:=xlA1) を .Name = "=[動的シート参照]!" に変更したい & MultiSel.Address(ReferenceStyle:=xlA1)

Sub ChartUSA()
' Keyboard Shortcut: Ctrl+y
'
    Dim MultiSel As Range
    Dim addr, cellAdd_name, cellAdd_Xaxis, cellAdd_Yaxis As Variant
    Dim cnt As Integer
    Dim ws As Worksheet
    cnt = 0

    ' make sure a range is selected
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set ws = ActiveSheet

     'For Each cnt In Selection
     For Each MultiSel In Selection
     cnt = cnt + 1

     'ActiveSheet.ChartObjects("Chart USA").Activate
     Sheets("ChartUSASX").ChartObjects("Chart USA").Activate
     ActiveChart.PlotArea.Select

     With ActiveChart.SeriesCollection.NewSeries
         .Name = "=ws!" & MultiSel.Address(ReferenceStyle:=xlA1)
         .XValues = "='US Sector (2)'!" & MultiSel.Offset(0, 24).Address(False, False)
         .Values = "='US Sector (2)'!" & MultiSel.Offset(0, 25).Address(False, False)

        .MarkerSize = 10
        .ApplyDataLabels
        .DataLabels.Select
         Selection.ShowSeriesName = True
        Selection.ShowValue = False
        .MarkerSize = 10

     End With


    Next

End Sub
4

1 に答える 1

0 
Sub ChartUSA()

    Dim MultiSel As Range
    Dim cht As Chart

    If TypeName(Selection) <> "Range" Then Exit Sub

    Set cht = Sheets("ChartUSASX").ChartObjects("Chart USA").Chart

    For Each MultiSel In Selection.Cells
        With cht.SeriesCollection.NewSeries
            .Name = "=" & RangeAddress(MultiSel)
            .XValues = "=" & RangeAddress(MultiSel.Offset(0, 1))
            .Values = "=" & RangeAddress(MultiSel.Offset(0, 2))
            .MarkerSize = 10
            .ApplyDataLabels
            With .DataLabels
                .ShowSeriesName = True
                .ShowValue = False
            End With
            .MarkerSize = 10
        End With
    Next
End Sub

Function RangeAddress(rng As Range) As String
    RangeAddress = "'" & rng.Parent.Name & "'!" & rng.Address(False, False)
End Function
于 2013-08-23T00:14:39.833 に答える