[[20150226130508]]　『地図上に?ｂ?付けたい』（ＹＡＳＵＭＡＴＵ）　ページの最後に飛ぶ

『地図上に?ｂ?付けたい』（ＹＡＳＵＭＡＴＵ）

いつもお世話になってます。

またよろしくお願いします。

同市内の複数の工事現場の位置が地図上で分かるようにして欲しいとの要望がありました。

ｿﾌﾄがあるとは思うのですが、一応EXCELで作ってみようと思ったのですが、つまずいてしまったので教えて下さい。

Sheet1にデータ　

 　A　　B　　　　C　　　　　D　　　　　　E
1 NO.　担当者　工事NO.　　工事名　　　工事場所
2 １　 田中　　A1234　　○○工事　　　世田谷区大蔵
3 ２　 山本　　C1224　　◎◎工事　　　世田谷区粕谷
4 ３　 山田　　A3444　　○◎工事　　　大田区

　
Sheet2にYahoo!地図から900mの世田谷区の地図を貼り付け、Sheet3に大田区の地図を貼り付けました。

A2のNO.の１をカメラ機能で地図に貼り付け、E2の住所をﾊｲﾊﾟｰﾘﾝｸに設定してSheet2に行くようにしました。

１と２がSheet2の世田谷区のそれぞれの場所での確認が出来、そこまでは良かったのですが、Sheet1のデータを工事NO.順に並び替えてしまうと地図上のNO.が変わってしまいます。

NO.とデータとの関係がうまくいっていないと思うのですが、リンク貼付やコピー貼付でやってみましたが駄目でした。

データを入れ替えても地図上でのNO.は変わらず、行削除したらそのNO.が消えるような事は出来ないでしょうか？

説明不足な点があるかとも思いますが、よろしくお願いします。

ちなみにマクロは出来ません。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

結構難しいコーディングなので、マクロはできないと言い切る方にはお薦めできないのですが…。
以下のマクロを実行すると、画像名を抜き出してG列にセット。C列を基準にソートを行なった後、G列の情報を元に、新たにリンクを設定し直しています。

 Sub test()
    Dim S As Shape
    Dim i As Long
    Dim iMax As Long
    Dim cw As String

    iMax = Cells(Rows.Count, "C").End(xlUp).Row

    With Sheets("Sheet2")
        .Activate
        For Each S In .Shapes
            S.Select
            cw = Selection.Formula
            If cw <> "" Then
                Range(cw).Offset(, 6) = S.Name  'G列に名前を待避
            End If
        Next
    End With

    Me.Activate
    Sort.SortFields.Clear
    Sort.SortFields.Add Key:=Range("C1:C" & iMax), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With Me.Sort
        .SetRange Range("A1:G" & iMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Sheet2").Activate
    For i = 2 To iMax
        If Me.Cells(i, "G").Value <> "" Then
            Sheets("Sheet2").Shapes(Me.Cells(i, "G").Value).Select
            Selection.Formula = "=" & Me.Name & "!A" & i
        End If
    Next i

    Me.Activate
    Me.Columns("G").ClearContents
 End Sub
（???） 2015/02/26(木) 16:52

ちなみに、行削除も同じような感じで、リンクが#REF!になっていた場合は画像を削除、とかで実現できそうですが、1行削除なら手動で画像の番号も削除しても良いかと…。

ソートは理解できた、削除も多数行うのでいちいちリンク切れを目視確認できない、というならば、別途#REF!画像削除を作ってみますが。
（???） 2015/02/26(木) 17:00

名前を待避しているあたりを、以下のように修正、で十分かな。
ソート不要なときでも、これを動かせばリンク切れ画像を消します。

            If cw <> "" Then
                If 0 < InStr(cw, "#REF!") Then
                    S.Delete
                Else
                    Range(cw).Offset(, 6) = S.Name  'G列に名前を待避
                End If
            End If
（???） 2015/02/26(木) 17:11

例ではSheet2だけですが、Sheet3にも画像がある記述がありますね。ということは、複数シートを対象にしないと、でしょうか。

 Sub test()
    Dim S As Shape
    Dim i As Long
    Dim iMax As Long
    Dim cw As String

    Application.ScreenUpdating = False
    iMax = Cells(Rows.Count, "C").End(xlUp).Row

    For i = 1 To Sheets.Count
        If Me.Name <> Sheets(i).Name Then
            With Sheets(i)
                .Activate
                For Each S In .Shapes
                    S.Select
                    cw = Selection.Formula
                    If cw <> "" Then
                        If 0 < InStr(cw, "#REF!") Then
                            S.Delete
                        Else
                            Range(cw).Offset(, 6) = S.Name  'G列に名前を待避
                            Range(cw).Offset(, 7) = .Name
                        End If
                    End If
                Next
            End With
        End If
    Next i

    Me.Activate
    Sort.SortFields.Clear
    Sort.SortFields.Add Key:=Range("C1:C" & iMax), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Me.Sort
        .SetRange Range("A1:H" & iMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    For i = 2 To iMax
        If Me.Cells(i, "G").Value <> "" Then
            Sheets(Me.Cells(i, "H").Value).Activate
            Sheets(Me.Cells(i, "H").Value).Shapes(Me.Cells(i, "G").Value).Select
            Selection.Formula = "=" & Me.Name & "!A" & i
        End If
    Next i

    Me.Activate
    Me.Columns("G:H").ClearContents
    Application.ScreenUpdating = True
 End Sub
（???） 2015/02/26(木) 17:43

 ＞A2のNO.の１をカメラ機能で地図に貼り付け
 この時、直接A列の値を見るのではなく、どこかあいた場所（G1とか）に
 =IF(COUNTIF($A:$A,COLUMN(A1)),COLUMN(A1),"")　こんな式を入れて
 列方向にフィルドラッグ。

 G列を先頭(「1」）にして、A列に値がある場合はそのNOが表示されます。

 これらのセルを、カメラ機能で地図に貼りつけてはどうでしょう。

 データを消した場合、地図上の表示は消えますが　図形は残りますので
 必要であれば手作業で削除してもらうことになりますが。
 　
（HANA） 2015/02/27(金) 08:22

お礼が遅くなってすみません。

色々試してみてました。

結局、ハイパーリンクとカメラ機能を使うことで要望に応えられる物がどうにか出来ました。

マクロはやっぱり無理です～～

ありがとうございました。

（ＹＡＳＵＭＡＴＵ） 2015/03/19(木) 14:06

コメント返信：

[ 一覧(最新更新順) ]

[[20150226130508]] 『地図上に?ｂ?付けたい』（ＹＡＳＵＭＡＴＵ） ページの最後に飛ぶ

[[20150226130508]]　『地図上に?ｂ?付けたい』（ＹＡＳＵＭＡＴＵ）　ページの最後に飛ぶ